module io_fortran_lib !------------------------------------------------------------------------------------------------------------------ !! This module provides common I/O routines for data of `integer`, `real`, `complex`, and `character` type, and !! a derived type `String` for advanced character handling and text file I/O. This module is F2018 compliant, has !! no external dependencies, and has a max line length of 120. !------------------------------------------------------------------------------------------------------------------ use, intrinsic :: iso_fortran_env, only: real128, real64, real32, int64, int32, int16, int8, & ! Standard kinds input_unit, output_unit, compiler_version use, intrinsic :: iso_c_binding, only: c_null_char ! The C null character implicit none (type,external) ! No implicit types or interfaces private ! Public API list ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ public :: aprint, to_file, from_file ! Array I/O public :: String, str, cast, join, split, echo ! String I/O public :: NL, SPACE, CR, FF, VT, LF, TAB, HT, BELL, NUL, CNUL, EMPTY_STR ! Constants public :: operator(//), operator(+), operator(-), operator(**), operator(==), operator(/=) ! Operators ! Definitions and Interfaces ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ character(len=1), parameter :: NL = new_line('a') !! The newline character (system agnostic). character(len=1), parameter :: SPACE = achar(32) !! The space character. character(len=1), parameter :: CR = achar(13) !! The carriage return character. character(len=1), parameter :: FF = achar(12) !! The form feed character. character(len=1), parameter :: VT = achar(11) !! The vertical tab character. character(len=1), parameter :: LF = achar(10) !! The line feed character. character(len=1), parameter :: TAB = achar(9) !! The horizontal tab character. character(len=1), parameter :: HT = achar(9) !! The horizontal tab character (alternate name). character(len=1), parameter :: BELL = achar(7) !! The bell/alert character. character(len=1), parameter :: NUL = achar(0) !! The null character. character(len=1), parameter :: CNUL = c_null_char !! The C null character re-exported from iso_c_binding. character(len=0), parameter :: EMPTY_STR = '' !! The empty string. character(len=*), parameter :: COMPILER = compiler_version() character(len=1), parameter :: SEMICOLON = achar(59) ! Semicolon character(len=1), parameter :: POINT = achar(46) ! Full stop character(len=1), parameter :: COMMA = achar(44) ! Comma character(len=1), parameter :: QQUOTE = achar(34) ! Double quote character(len=1), dimension(*), parameter :: INT_FMTS = [ 'i', 'z' ] ! Allowed formats for integers character(len=1), dimension(*), parameter :: REAL_FMTS = [ 'e', 'f', 'z' ] ! Allowed formats for floats character(len=2), dimension(*), parameter :: LOCALES = [ 'US', 'EU' ] ! Allowed locale specifiers character(len=3), dimension(*), parameter :: BINARY_EXT = [ 'dat', 'bin' ] ! Allowed binary extensions character(len=3), dimension(*), parameter :: TEXT_EXT = [ 'csv', 'txt', 'log', & ! Allowed text extensions 'rtf', 'odm', 'odt', & 'ods', 'odf', 'xls', & 'doc', 'org', 'dbf', & 'bed', 'gff', 'gtf' ] type String !-------------------------------------------------------------------------------------------------------------- !! A growable string type for advanced character handling and text I/O. !! !! For a user reference, see [String](../page/Ref/String.html), !! [String methods](../page/Ref/String-methods.html), and [Operators](../page/Ref/operators.html). !! !! @note TECHNICAL NOTE: The `String` type is memory safe. The user will never need to be concerned about !! accessing invalid memory when using the `String` type. Any operation defined in this documentation for the !! `String` type which may involve a `String` with an unallocated component, or arrays of `String`s in which !! some of the elements may have unallocated components, is well-defined. In all such cases, the component is !! treated as the [empty string](../module/io_fortran_lib.html#variable-empty_str). !-------------------------------------------------------------------------------------------------------------- private character(len=:), allocatable :: s !! Component is a string slice contains private ! Generics ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ generic, public :: cast => cast_string_to_c128, cast_string_to_c64, cast_string_to_c32, & cast_string_to_r128, cast_string_to_r64, cast_string_to_r32, & cast_string_to_i64, cast_string_to_i32, cast_string_to_i16, & cast_string_to_i8 generic, public :: count => count_substring_chars, count_substring_string generic, public :: echo => echo_string generic, public :: push => push_chars, push_string generic, public :: replace => replace_ch_copy, replace_st_copy, replace_chst_copy, & replace_stch_copy generic, public :: replace_inplace => replace_ch_inplace, replace_st_inplace, replace_chst_inplace, & replace_stch_inplace generic, public :: split => split_string generic, public :: write(formatted) => write_string ! Specifics ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ procedure, pass(self), public :: as_str procedure, pass(substring) :: cast_string_to_c128, cast_string_to_c64, cast_string_to_c32, & cast_string_to_r128, cast_string_to_r64, cast_string_to_r32, & cast_string_to_i64, cast_string_to_i32, cast_string_to_i16, & cast_string_to_i8 procedure, pass(self) :: count_substring_chars, count_substring_string procedure, pass(substring) :: echo_string procedure, pass(self), public :: empty procedure, pass(self), public :: join => join_into_self procedure, pass(self) :: join_base procedure, pass(self), public :: len => length procedure, pass(self), public :: len64 => length64 procedure, pass(self) :: push_chars, push_string procedure, pass(self), public :: read_file procedure, pass(self) :: replace_ch_copy, replace_st_copy, replace_chst_copy, & replace_stch_copy, replace_ch_inplace, replace_st_inplace, & replace_chst_inplace, replace_stch_inplace procedure, pass(substring) :: split_string procedure, pass(self), public :: trim => trim_copy procedure, pass(self), public :: trim_inplace procedure, pass(self), public :: write_file procedure, pass(substring) :: write_string final :: scrub end type String interface ! Submodule string_methods !-------------------------------------------------------------------------------------------------------------- !! Methods for the `String` type. !-------------------------------------------------------------------------------------------------------------- pure recursive module function as_str(self) result(string_slice) !---------------------------------------------------------------------------------------------------------- !! Returns a copy of the string slice component of a scalar `String`. !! !! For a user reference, see [as_str](../page/Ref/String-methods.html#as_str). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=:), allocatable :: string_slice end function as_str pure elemental recursive integer module function count_substring_chars(self, match) result(occurrences) !---------------------------------------------------------------------------------------------------------- !! Returns number of non-overlapping occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=*), intent(in) :: match end function count_substring_chars pure elemental recursive integer module function count_substring_string(self, match) result(occurrences) !---------------------------------------------------------------------------------------------------------- !! Returns number of non-overlapping occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self type(String), intent(in) :: match end function count_substring_string pure elemental recursive module subroutine empty(self) !---------------------------------------------------------------------------------------------------------- !! Sets the string slice component to the empty string elementally. This procedure is identical in function !! to the assignment `self = String()`. !! !! For a user reference, see [empty](../page/Ref/String-methods.html#empty). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self end subroutine empty pure recursive module subroutine join_into_self(self, tokens, separator) !---------------------------------------------------------------------------------------------------------- !! Joins a `String` vector `tokens` into `self` with given separator. Default separator is SPACE. The !! string slice component will be replaced if already allocated. !! !! For a user reference, see [join](../page/Ref/String-methods.html#join). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), dimension(:), intent(in) :: tokens character(len=*), intent(in), optional :: separator end subroutine join_into_self pure recursive module subroutine join_base(self, tokens, separator) !---------------------------------------------------------------------------------------------------------- !! Tail recursion routine for `join_string` and `join_into_self`. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), dimension(:), intent(in) :: tokens character(len=*), intent(in) :: separator end subroutine join_base pure elemental recursive integer module function length(self) result(self_len) !---------------------------------------------------------------------------------------------------------- !! Returns the length of the string slice component elementally. Unallocated components return `-1`. !! !! For a user reference, see [len](../page/Ref/String-methods.html#len). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self end function length pure elemental recursive integer(int64) module function length64(self) result(self_len) !---------------------------------------------------------------------------------------------------------- !! Returns the length of the string slice component elementally. Unallocated components return `-1`. This !! function is identical to `len` for strings of 2,147,483,647 bytes or smaller. !! !! For a user reference, see [len](../page/Ref/String-methods.html#len). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self end function length64 pure elemental recursive module subroutine push_chars(self, substring) !---------------------------------------------------------------------------------------------------------- !! Appends characters to the string slice component elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: substring end subroutine push_chars pure elemental recursive module subroutine push_string(self, substring) !---------------------------------------------------------------------------------------------------------- !! Appends string to the string slice component elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), intent(in) :: substring end subroutine push_string impure recursive module subroutine read_file(self, file_name, cell_array, row_separator, column_separator) !---------------------------------------------------------------------------------------------------------- !! Reads raw text file contents into `self` and optionally populates a cell array using the designated !! `row_separator` and `column_separator` whose default values are `LF` and `COMMA` respectively. !! !! For a user reference, see [read_file](../page/Ref/String-methods.html#read_file). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: file_name type(String), allocatable, dimension(:,:), intent(out), optional :: cell_array character(len=*), intent(in), optional :: row_separator, column_separator end subroutine read_file pure elemental recursive type(String) module function replace_ch_copy(self, match, substring, back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=*), intent(in) :: match, substring logical, intent(in), optional :: back end function replace_ch_copy pure elemental recursive type(String) module function replace_st_copy(self, match, substring, back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self type(String), intent(in) :: match, substring logical, intent(in), optional :: back end function replace_st_copy pure elemental recursive type(String) module function replace_chst_copy(self, match,substring,back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=*), intent(in) :: match type(String), intent(in) :: substring logical, intent(in), optional :: back end function replace_chst_copy pure elemental recursive type(String) module function replace_stch_copy(self, match,substring,back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self type(String), intent(in) :: match character(len=*), intent(in) :: substring logical, intent(in), optional :: back end function replace_stch_copy pure elemental recursive module subroutine replace_ch_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: match, substring logical, intent(in), optional :: back end subroutine replace_ch_inplace pure elemental recursive module subroutine replace_st_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), intent(in) :: match, substring logical, intent(in), optional :: back end subroutine replace_st_inplace pure elemental recursive module subroutine replace_chst_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: match type(String), intent(in) :: substring logical, intent(in), optional :: back end subroutine replace_chst_inplace pure elemental recursive module subroutine replace_stch_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), intent(in) :: match character(len=*), intent(in) :: substring logical, intent(in), optional :: back end subroutine replace_stch_inplace pure elemental recursive type(String) module function trim_copy(self) result(new) !---------------------------------------------------------------------------------------------------------- !! Returns a copy of a `String` elementally in which each string slice component has been trimmed of any !! leading or trailing whitespace. !! !! For a user reference, see [trim](../page/Ref/String-methods.html#trim). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self end function trim_copy pure elemental recursive module subroutine trim_inplace(self) !---------------------------------------------------------------------------------------------------------- !! Removes any leading or trailing whitespace of the string slice component of a `String` elementally and !! in place. !! !! For a user reference, see [trim_inplace](../page/Ref/String-methods.html#trim_inplace). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self end subroutine trim_inplace impure recursive module subroutine write_file(self, cell_array,file_name,row_separator,column_separator,append) !---------------------------------------------------------------------------------------------------------- !! Writes the content of a cell array to a text file. The cell array's entire contents are populated into !! `self` and then streamed to an external text file using the designated `row_separator` and !! `column_separator` whose default values are `LF` and `COMMA` respectively. !! !! For a user reference, see [write_file](../page/Ref/String-methods.html#write_file). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), dimension(:,:), intent(in) :: cell_array character(len=*), intent(in) :: file_name character(len=*), intent(in), optional :: row_separator, column_separator logical, intent(in), optional :: append end subroutine write_file impure recursive module subroutine write_string(substring, unit, iotype, v_list, iostat, iomsg) !---------------------------------------------------------------------------------------------------------- !! Formatted write DTIO procedure for type `String`. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: substring integer, intent(in) :: unit character(len=*), intent(in) :: iotype integer, dimension(:), intent(in) :: v_list integer, intent(out) :: iostat character(len=*), intent(inout) :: iomsg end subroutine write_string pure elemental recursive module subroutine scrub(self) !---------------------------------------------------------------------------------------------------------- !! Finalization procedure for type `String`. !---------------------------------------------------------------------------------------------------------- type(String), intent(inout) :: self end subroutine scrub end interface interface operator(//) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Concatenation operator for `character` and `String`, lifted from `character`. Mixed type concatenation of !! `character` and `String` is explicitly defined. !! !! For a user reference, see [Concatenation](../page/Ref/operators.html#concatenation). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive type(String) module function string_concatenation(Stringl, Stringr) result(new) class(String), intent(in) :: Stringl, Stringr end function string_concatenation pure elemental recursive type(String) module function string_char_concatenation(Stringl, charsr) result(new) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_concatenation pure elemental recursive type(String) module function char_string_concatenation(charsl, Stringr) result(new) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_concatenation end interface interface operator(+) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Concatenation operator for `character` and `String` (as addition). Mixed type concatenation of !! `character` and `String` is explicitly defined. !! !! For a user reference, see [Concatenation](../page/Ref/operators.html#concatenation). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive module function char_concat_plus(charsl, charsr) result(new) character(len=*), intent(in) :: charsl, charsr character(len=len(charsl)+len(charsr)) :: new end function char_concat_plus pure elemental recursive type(String) module function string_concat_plus(Stringl, Stringr) result(new) class(String), intent(in) :: Stringl, Stringr end function string_concat_plus pure elemental recursive type(String) module function string_char_concat_plus(Stringl, charsr) result(new) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_concat_plus pure elemental recursive type(String) module function char_string_concat_plus(charsl, Stringr) result(new) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_concat_plus end interface interface operator(-) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Excision operator for `character` and `String` (as subtraction). Mixed type excision of `character` and !! `String` is explicitly defined. !! !! For a user reference, see [Excision](../page/Ref/operators.html#excision). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive type(String) module function char_excision(charsl, charsr) result(new) character(len=*), intent(in) :: charsl, charsr end function char_excision pure elemental recursive type(String) module function string_excision(Stringl, Stringr) result(new) class(String), intent(in) :: Stringl, Stringr end function string_excision pure elemental recursive type(String) module function string_char_excision(Stringl, charsr) result(new) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_excision pure elemental recursive type(String) module function char_string_excision(charsl, Stringr) result(new) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_excision end interface interface operator(**) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Repetition operator for `character` and `String` (as exponentiation). !! !! For a user reference, see [Repetition](../page/Ref/operators.html#repetition). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive module function repeat_chars(char_base, ncopies) result(new) character(len=*), intent(in) :: char_base integer, intent(in) :: ncopies character(len=len(char_base)*ncopies) :: new end function repeat_chars pure elemental recursive type(String) module function repeat_String(String_base, ncopies) result(new) class(String), intent(in) :: String_base integer, intent(in) :: ncopies end function repeat_String end interface interface operator(==) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Equivalence operator for `character` and `String`. Mixed type equivalence of `character` and `String` is !! explicitly defined. !! !! For a user reference, see [Equivalence](../page/Ref/operators.html#equivalence). !! !! @note The equivalence operator `==` is interchangeable with `.eq.`. !-------------------------------------------------------------------------------------------------------------- pure elemental recursive logical module function string_equivalence(Stringl, Stringr) result(equal) class(String), intent(in) :: Stringl, Stringr end function string_equivalence pure elemental recursive logical module function string_char_equivalence(Stringl, charsr) result(equal) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_equivalence pure elemental recursive logical module function char_string_equivalence(charsl, Stringr) result(equal) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_equivalence end interface interface operator(/=) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Non-equivalence operator for `character` and `String`. Mixed type non-equivalence of `character` and !! `String` is explicitly defined. !! !! For a user reference, see [Non-equivalence](../page/Ref/operators.html#non-equivalence). !! !! @note The non-equivalence operator `/=` is interchangeable with `.ne.`. !-------------------------------------------------------------------------------------------------------------- pure elemental recursive logical module function string_nonequivalence(Stringl, Stringr) result(unequal) class(String), intent(in) :: Stringl, Stringr end function string_nonequivalence pure elemental recursive logical module function string_char_nonequivalence(Stringl, charsr) result(unequal) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_nonequivalence pure elemental recursive logical module function char_string_nonequivalence(charsl, Stringr) result(unequal) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_nonequivalence end interface interface String ! Submodule internal_io !-------------------------------------------------------------------------------------------------------------- !! Function for returning a [String](../type/string.html) representation of numbers. !! !! For a user reference, see [String](../page/Ref/String.html), !! [String methods](../page/Ref/String-methods.html), and [Operators](../page/Ref/operators.html). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive type(String) module function new_string_from_c128(x,locale,fmt,decimals,im)result(new) complex(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end function new_string_from_c128 pure elemental recursive type(String) module function new_string_from_c64(x,locale,fmt,decimals,im) result(new) complex(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end function new_string_from_c64 pure elemental recursive type(String) module function new_string_from_c32(x,locale,fmt,decimals,im) result(new) complex(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end function new_string_from_c32 pure elemental recursive type(String) module function new_string_from_r128(x, locale, fmt, decimals)result(new) real(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end function new_string_from_r128 pure elemental recursive type(String) module function new_string_from_r64(x, locale, fmt, decimals) result(new) real(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end function new_string_from_r64 pure elemental recursive type(String) module function new_string_from_r32(x, locale, fmt, decimals) result(new) real(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end function new_string_from_r32 pure elemental recursive type(String) module function new_string_from_i64(x, fmt) result(new) integer(int64), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_string_from_i64 pure elemental recursive type(String) module function new_string_from_i32(x, fmt) result(new) integer(int32), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_string_from_i32 pure elemental recursive type(String) module function new_string_from_i16(x, fmt) result(new) integer(int16), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_string_from_i16 pure elemental recursive type(String) module function new_string_from_i8(x, fmt) result(new) integer(int8), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_string_from_i8 pure elemental recursive type(String) module function new_string_from_string(x) result(new) class(String), intent(in) :: x end function new_string_from_string pure elemental recursive type(String) module function new_string_from_char(x) result(new) character(len=*), intent(in) :: x end function new_string_from_char pure elemental recursive type(String) module function new_string_from_empty() result(new) ! No arguments end function new_string_from_empty end interface interface str ! Submodule internal_io !-------------------------------------------------------------------------------------------------------------- !! Function for returning a `character` representation of a number. !! !! For a user reference, see [str](../page/Ref/str.html). !-------------------------------------------------------------------------------------------------------------- pure recursive module function str_from_c128(x, locale, fmt, decimals, im) result(x_str) complex(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im character(len=:), allocatable :: x_str end function str_from_c128 pure recursive module function str_from_c64(x, locale, fmt, decimals, im) result(x_str) complex(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im character(len=:), allocatable :: x_str end function str_from_c64 pure recursive module function str_from_c32(x, locale, fmt, decimals, im) result(x_str) complex(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im character(len=:), allocatable :: x_str end function str_from_c32 pure recursive module function str_from_r128(x, locale, fmt, decimals) result(x_str) real(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=:), allocatable :: x_str end function str_from_r128 pure recursive module function str_from_r64(x, locale, fmt, decimals) result(x_str) real(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=:), allocatable :: x_str end function str_from_r64 pure recursive module function str_from_r32(x, locale, fmt, decimals) result(x_str) real(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=:), allocatable :: x_str end function str_from_r32 pure recursive module function str_from_i64(x, fmt) result(x_str) integer(int64), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_from_i64 pure recursive module function str_from_i32(x, fmt) result(x_str) integer(int32), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_from_i32 pure recursive module function str_from_i16(x, fmt) result(x_str) integer(int16), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_from_i16 pure recursive module function str_from_i8(x, fmt) result(x_str) integer(int8), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_from_i8 pure recursive module function str_from_string(x) result(x_str) class(String), intent(in) :: x character(len=:), allocatable :: x_str end function str_from_string pure recursive module function str_from_char(x) result(x_str) character(len=*), intent(in) :: x character(len=:), allocatable :: x_str end function str_from_char pure recursive module function str_from_empty() result(x_str) character(len=:), allocatable :: x_str end function str_from_empty end interface interface cast ! Submodule internal_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for casting between numeric and string data. !! !! For a user reference, see [cast](../page/Ref/cast.html). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive module subroutine cast_c128_to_string(x, into, locale, fmt, decimals, im) complex(real128), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine cast_c128_to_string pure elemental recursive module subroutine cast_c64_to_string(x, into, locale, fmt, decimals, im) complex(real64), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine cast_c64_to_string pure elemental recursive module subroutine cast_c32_to_string(x, into, locale, fmt, decimals, im) complex(real32), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine cast_c32_to_string pure elemental recursive module subroutine cast_r128_to_string(x, into, locale, fmt, decimals) real(real128), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine cast_r128_to_string pure elemental recursive module subroutine cast_r64_to_string(x, into, locale, fmt, decimals) real(real64), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine cast_r64_to_string pure elemental recursive module subroutine cast_r32_to_string(x, into, locale, fmt, decimals) real(real32), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine cast_r32_to_string pure elemental recursive module subroutine cast_i64_to_string(x, into, fmt) integer(int64), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i64_to_string pure elemental recursive module subroutine cast_i32_to_string(x, into, fmt) integer(int32), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i32_to_string pure elemental recursive module subroutine cast_i16_to_string(x, into, fmt) integer(int16), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i16_to_string pure elemental recursive module subroutine cast_i8_to_string(x, into, fmt) integer(int8), intent(in) :: x type(String), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i8_to_string pure recursive module subroutine cast_c128_to_char(x, into, locale, fmt, decimals, im) complex(real128), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine cast_c128_to_char pure recursive module subroutine cast_c64_to_char(x, into, locale, fmt, decimals, im) complex(real64), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine cast_c64_to_char pure recursive module subroutine cast_c32_to_char(x, into, locale, fmt, decimals, im) complex(real32), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine cast_c32_to_char pure recursive module subroutine cast_r128_to_char(x, into, locale, fmt, decimals) real(real128), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine cast_r128_to_char pure recursive module subroutine cast_r64_to_char(x, into, locale, fmt, decimals) real(real64), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine cast_r64_to_char pure recursive module subroutine cast_r32_to_char(x, into, locale, fmt, decimals) real(real32), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine cast_r32_to_char pure recursive module subroutine cast_i64_to_char(x, into, fmt) integer(int64), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i64_to_char pure recursive module subroutine cast_i32_to_char(x, into, fmt) integer(int32), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i32_to_char pure recursive module subroutine cast_i16_to_char(x, into, fmt) integer(int16), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i16_to_char pure recursive module subroutine cast_i8_to_char(x, into, fmt) integer(int8), intent(in) :: x character(len=:), allocatable, intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i8_to_char pure elemental recursive module subroutine cast_string_to_c128(substring, into, locale, fmt, im) class(String), intent(in) :: substring complex(real128), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_string_to_c128 pure elemental recursive module subroutine cast_string_to_c64(substring, into, locale, fmt, im) class(String), intent(in) :: substring complex(real64), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_string_to_c64 pure elemental recursive module subroutine cast_string_to_c32(substring, into, locale, fmt, im) class(String), intent(in) :: substring complex(real32), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_string_to_c32 pure elemental recursive module subroutine cast_string_to_r128(substring, into, locale, fmt) class(String), intent(in) :: substring real(real128), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_r128 pure elemental recursive module subroutine cast_string_to_r64(substring, into, locale, fmt) class(String), intent(in) :: substring real(real64), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_r64 pure elemental recursive module subroutine cast_string_to_r32(substring, into, locale, fmt) class(String), intent(in) :: substring real(real32), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_r32 pure elemental recursive module subroutine cast_string_to_i64(substring, into, fmt) class(String), intent(in) :: substring integer(int64), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_i64 pure elemental recursive module subroutine cast_string_to_i32(substring, into, fmt) class(String), intent(in) :: substring integer(int32), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_i32 pure elemental recursive module subroutine cast_string_to_i16(substring, into, fmt) class(String), intent(in) :: substring integer(int16), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_i16 pure elemental recursive module subroutine cast_string_to_i8(substring, into, fmt) class(String), intent(in) :: substring integer(int8), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_to_i8 pure recursive module subroutine cast_char_to_c128(substring, into, locale, fmt, im) character(len=*), intent(in) :: substring complex(real128), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_char_to_c128 pure recursive module subroutine cast_char_to_c64(substring, into, locale, fmt, im) character(len=*), intent(in) :: substring complex(real64), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_char_to_c64 pure recursive module subroutine cast_char_to_c32(substring, into, locale, fmt, im) character(len=*), intent(in) :: substring complex(real32), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_char_to_c32 pure recursive module subroutine cast_char_to_r128(substring, into, locale, fmt) character(len=*), intent(in) :: substring real(real128), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_r128 pure recursive module subroutine cast_char_to_r64(substring, into, locale, fmt) character(len=*), intent(in) :: substring real(real64), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_r64 pure recursive module subroutine cast_char_to_r32(substring, into, locale, fmt) character(len=*), intent(in) :: substring real(real32), intent(inout) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_r32 pure recursive module subroutine cast_char_to_i64(substring, into, fmt) character(len=*), intent(in) :: substring integer(int64), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_i64 pure recursive module subroutine cast_char_to_i32(substring, into, fmt) character(len=*), intent(in) :: substring integer(int32), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_i32 pure recursive module subroutine cast_char_to_i16(substring, into, fmt) character(len=*), intent(in) :: substring integer(int16), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_i16 pure recursive module subroutine cast_char_to_i8(substring, into, fmt) character(len=*), intent(in) :: substring integer(int8), intent(inout) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_char_to_i8 end interface interface join ! Submodule join_split !-------------------------------------------------------------------------------------------------------------- !! Function for joining a vector of `tokens` into a scalar `character` or `String`. !! !! For a user reference, see [join](../page/Ref/join-split.html). !-------------------------------------------------------------------------------------------------------------- pure recursive module function join_char(tokens, separator) result(new) character(len=*), dimension(:), intent(in) :: tokens character(len=*), intent(in), optional :: separator character(len=:), allocatable :: new end function join_char pure recursive type(String) module function join_string(tokens, separator) result(new) type(String), dimension(:), intent(in) :: tokens character(len=*), intent(in), optional :: separator end function join_string end interface interface split ! Submodule join_split !-------------------------------------------------------------------------------------------------------------- !! Function for splitting a scalar `character` or `String` into a vector of `tokens`. !! !! For a user reference, see [split](../page/Ref/join-split.html). !-------------------------------------------------------------------------------------------------------------- pure recursive module function split_char(substring, separator) result(tokens) character(len=*), intent(in) :: substring character(len=*), intent(in), optional :: separator type(String), allocatable, dimension(:) :: tokens end function split_char pure recursive module function split_string(substring, separator) result(tokens) class(String), intent(in) :: substring character(len=*), intent(in), optional :: separator type(String), allocatable, dimension(:) :: tokens end function split_string end interface interface to_file ! Submodule file_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for writing an array of uniform numeric data type to an external file. !! !! For a user reference, see [to_file](../page/Ref/to_file.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine to_file_1dc128(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_1dc128 impure recursive module subroutine to_file_1dc64(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_1dc64 impure recursive module subroutine to_file_1dc32(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_1dc32 impure recursive module subroutine to_file_2dc128(x, file_name, header, locale, delim, fmt, decimals, im) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_2dc128 impure recursive module subroutine to_file_2dc64(x, file_name, header, locale, delim, fmt, decimals, im) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_2dc64 impure recursive module subroutine to_file_2dc32(x, file_name, header, locale, delim, fmt, decimals, im) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_2dc32 impure recursive module subroutine to_file_3dc128(x, file_name) complex(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dc128 impure recursive module subroutine to_file_3dc64(x, file_name) complex(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dc64 impure recursive module subroutine to_file_3dc32(x, file_name) complex(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dc32 impure recursive module subroutine to_file_4dc128(x, file_name) complex(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dc128 impure recursive module subroutine to_file_4dc64(x, file_name) complex(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dc64 impure recursive module subroutine to_file_4dc32(x, file_name) complex(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dc32 impure recursive module subroutine to_file_5dc128(x, file_name) complex(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dc128 impure recursive module subroutine to_file_5dc64(x, file_name) complex(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dc64 impure recursive module subroutine to_file_5dc32(x, file_name) complex(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dc32 impure recursive module subroutine to_file_6dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dc128 impure recursive module subroutine to_file_6dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dc64 impure recursive module subroutine to_file_6dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dc32 impure recursive module subroutine to_file_7dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dc128 impure recursive module subroutine to_file_7dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dc64 impure recursive module subroutine to_file_7dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dc32 impure recursive module subroutine to_file_8dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dc128 impure recursive module subroutine to_file_8dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dc64 impure recursive module subroutine to_file_8dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dc32 impure recursive module subroutine to_file_9dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dc128 impure recursive module subroutine to_file_9dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dc64 impure recursive module subroutine to_file_9dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dc32 impure recursive module subroutine to_file_10dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dc128 impure recursive module subroutine to_file_10dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dc64 impure recursive module subroutine to_file_10dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dc32 impure recursive module subroutine to_file_11dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dc128 impure recursive module subroutine to_file_11dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dc64 impure recursive module subroutine to_file_11dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dc32 impure recursive module subroutine to_file_12dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dc128 impure recursive module subroutine to_file_12dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dc64 impure recursive module subroutine to_file_12dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dc32 impure recursive module subroutine to_file_13dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dc128 impure recursive module subroutine to_file_13dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dc64 impure recursive module subroutine to_file_13dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dc32 impure recursive module subroutine to_file_14dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dc128 impure recursive module subroutine to_file_14dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dc64 impure recursive module subroutine to_file_14dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dc32 impure recursive module subroutine to_file_15dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dc128 impure recursive module subroutine to_file_15dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dc64 impure recursive module subroutine to_file_15dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dc32 impure recursive module subroutine to_file_1dr128(x, file_name, header, dim, locale, delim, fmt, decimals) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_1dr128 impure recursive module subroutine to_file_1dr64(x, file_name, header, dim, locale, delim, fmt, decimals) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_1dr64 impure recursive module subroutine to_file_1dr32(x, file_name, header, dim, locale, delim, fmt, decimals) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_1dr32 impure recursive module subroutine to_file_2dr128(x, file_name, header, locale, delim, fmt, decimals) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_2dr128 impure recursive module subroutine to_file_2dr64(x, file_name, header, locale, delim, fmt, decimals) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_2dr64 impure recursive module subroutine to_file_2dr32(x, file_name, header, locale, delim, fmt, decimals) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_2dr32 impure recursive module subroutine to_file_3dr128(x, file_name) real(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dr128 impure recursive module subroutine to_file_3dr64(x, file_name) real(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dr64 impure recursive module subroutine to_file_3dr32(x, file_name) real(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dr32 impure recursive module subroutine to_file_4dr128(x, file_name) real(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dr128 impure recursive module subroutine to_file_4dr64(x, file_name) real(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dr64 impure recursive module subroutine to_file_4dr32(x, file_name) real(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dr32 impure recursive module subroutine to_file_5dr128(x, file_name) real(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dr128 impure recursive module subroutine to_file_5dr64(x, file_name) real(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dr64 impure recursive module subroutine to_file_5dr32(x, file_name) real(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dr32 impure recursive module subroutine to_file_6dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dr128 impure recursive module subroutine to_file_6dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dr64 impure recursive module subroutine to_file_6dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dr32 impure recursive module subroutine to_file_7dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dr128 impure recursive module subroutine to_file_7dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dr64 impure recursive module subroutine to_file_7dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dr32 impure recursive module subroutine to_file_8dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dr128 impure recursive module subroutine to_file_8dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dr64 impure recursive module subroutine to_file_8dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dr32 impure recursive module subroutine to_file_9dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dr128 impure recursive module subroutine to_file_9dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dr64 impure recursive module subroutine to_file_9dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dr32 impure recursive module subroutine to_file_10dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dr128 impure recursive module subroutine to_file_10dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dr64 impure recursive module subroutine to_file_10dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dr32 impure recursive module subroutine to_file_11dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dr128 impure recursive module subroutine to_file_11dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dr64 impure recursive module subroutine to_file_11dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dr32 impure recursive module subroutine to_file_12dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dr128 impure recursive module subroutine to_file_12dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dr64 impure recursive module subroutine to_file_12dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dr32 impure recursive module subroutine to_file_13dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dr128 impure recursive module subroutine to_file_13dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dr64 impure recursive module subroutine to_file_13dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dr32 impure recursive module subroutine to_file_14dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dr128 impure recursive module subroutine to_file_14dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dr64 impure recursive module subroutine to_file_14dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dr32 impure recursive module subroutine to_file_15dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dr128 impure recursive module subroutine to_file_15dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dr64 impure recursive module subroutine to_file_15dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dr32 impure recursive module subroutine to_file_1di64(x, file_name, header, dim, delim, fmt) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di64 impure recursive module subroutine to_file_1di32(x, file_name, header, dim, delim, fmt) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di32 impure recursive module subroutine to_file_1di16(x, file_name, header, dim, delim, fmt) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di16 impure recursive module subroutine to_file_1di8(x, file_name, header, dim, delim, fmt) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di8 impure recursive module subroutine to_file_2di64(x, file_name, header, delim, fmt) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di64 impure recursive module subroutine to_file_2di32(x, file_name, header, delim, fmt) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di32 impure recursive module subroutine to_file_2di16(x, file_name, header, delim, fmt) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di16 impure recursive module subroutine to_file_2di8(x, file_name, header, delim, fmt) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di8 impure recursive module subroutine to_file_3di64(x, file_name) integer(int64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di64 impure recursive module subroutine to_file_3di32(x, file_name) integer(int32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di32 impure recursive module subroutine to_file_3di16(x, file_name) integer(int16), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di16 impure recursive module subroutine to_file_3di8(x, file_name) integer(int8), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di8 impure recursive module subroutine to_file_4di64(x, file_name) integer(int64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di64 impure recursive module subroutine to_file_4di32(x, file_name) integer(int32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di32 impure recursive module subroutine to_file_4di16(x, file_name) integer(int16), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di16 impure recursive module subroutine to_file_4di8(x, file_name) integer(int8), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di8 impure recursive module subroutine to_file_5di64(x, file_name) integer(int64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di64 impure recursive module subroutine to_file_5di32(x, file_name) integer(int32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di32 impure recursive module subroutine to_file_5di16(x, file_name) integer(int16), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di16 impure recursive module subroutine to_file_5di8(x, file_name) integer(int8), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di8 impure recursive module subroutine to_file_6di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di64 impure recursive module subroutine to_file_6di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di32 impure recursive module subroutine to_file_6di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di16 impure recursive module subroutine to_file_6di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di8 impure recursive module subroutine to_file_7di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di64 impure recursive module subroutine to_file_7di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di32 impure recursive module subroutine to_file_7di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di16 impure recursive module subroutine to_file_7di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di8 impure recursive module subroutine to_file_8di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di64 impure recursive module subroutine to_file_8di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di32 impure recursive module subroutine to_file_8di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di16 impure recursive module subroutine to_file_8di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di8 impure recursive module subroutine to_file_9di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di64 impure recursive module subroutine to_file_9di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di32 impure recursive module subroutine to_file_9di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di16 impure recursive module subroutine to_file_9di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di8 impure recursive module subroutine to_file_10di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di64 impure recursive module subroutine to_file_10di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di32 impure recursive module subroutine to_file_10di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di16 impure recursive module subroutine to_file_10di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di8 impure recursive module subroutine to_file_11di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di64 impure recursive module subroutine to_file_11di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di32 impure recursive module subroutine to_file_11di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di16 impure recursive module subroutine to_file_11di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di8 impure recursive module subroutine to_file_12di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di64 impure recursive module subroutine to_file_12di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di32 impure recursive module subroutine to_file_12di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di16 impure recursive module subroutine to_file_12di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di8 impure recursive module subroutine to_file_13di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di64 impure recursive module subroutine to_file_13di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di32 impure recursive module subroutine to_file_13di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di16 impure recursive module subroutine to_file_13di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di8 impure recursive module subroutine to_file_14di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di64 impure recursive module subroutine to_file_14di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di32 impure recursive module subroutine to_file_14di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di16 impure recursive module subroutine to_file_14di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di8 impure recursive module subroutine to_file_15di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di64 impure recursive module subroutine to_file_15di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di32 impure recursive module subroutine to_file_15di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di16 impure recursive module subroutine to_file_15di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di8 end interface interface from_file ! Submodule file_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for reading an external file of uniform numeric data type and format into an array. !! !! For a user reference, see [from_file](../page/Ref/from_file.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine from_textfile_1dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_1dc128 impure recursive module subroutine from_binaryfile_1dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dc128 impure recursive module subroutine from_textfile_1dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_1dc64 impure recursive module subroutine from_binaryfile_1dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dc64 impure recursive module subroutine from_textfile_1dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_1dc32 impure recursive module subroutine from_binaryfile_1dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dc32 impure recursive module subroutine from_textfile_2dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_2dc128 impure recursive module subroutine from_binaryfile_2dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dc128 impure recursive module subroutine from_textfile_2dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_2dc64 impure recursive module subroutine from_binaryfile_2dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dc64 impure recursive module subroutine from_textfile_2dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_2dc32 impure recursive module subroutine from_binaryfile_2dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dc32 impure recursive module subroutine from_file_3dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dc128 impure recursive module subroutine from_file_3dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dc64 impure recursive module subroutine from_file_3dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dc32 impure recursive module subroutine from_file_4dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dc128 impure recursive module subroutine from_file_4dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dc64 impure recursive module subroutine from_file_4dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dc32 impure recursive module subroutine from_file_5dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dc128 impure recursive module subroutine from_file_5dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dc64 impure recursive module subroutine from_file_5dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dc32 impure recursive module subroutine from_file_6dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dc128 impure recursive module subroutine from_file_6dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dc64 impure recursive module subroutine from_file_6dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dc32 impure recursive module subroutine from_file_7dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dc128 impure recursive module subroutine from_file_7dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dc64 impure recursive module subroutine from_file_7dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dc32 impure recursive module subroutine from_file_8dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dc128 impure recursive module subroutine from_file_8dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dc64 impure recursive module subroutine from_file_8dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dc32 impure recursive module subroutine from_file_9dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dc128 impure recursive module subroutine from_file_9dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dc64 impure recursive module subroutine from_file_9dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dc32 impure recursive module subroutine from_file_10dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dc128 impure recursive module subroutine from_file_10dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dc64 impure recursive module subroutine from_file_10dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dc32 impure recursive module subroutine from_file_11dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dc128 impure recursive module subroutine from_file_11dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dc64 impure recursive module subroutine from_file_11dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dc32 impure recursive module subroutine from_file_12dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dc128 impure recursive module subroutine from_file_12dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dc64 impure recursive module subroutine from_file_12dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dc32 impure recursive module subroutine from_file_13dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dc128 impure recursive module subroutine from_file_13dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dc64 impure recursive module subroutine from_file_13dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dc32 impure recursive module subroutine from_file_14dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dc128 impure recursive module subroutine from_file_14dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dc64 impure recursive module subroutine from_file_14dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dc32 impure recursive module subroutine from_file_15dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dc128 impure recursive module subroutine from_file_15dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dc64 impure recursive module subroutine from_file_15dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dc32 impure recursive module subroutine from_textfile_1dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1dr128 impure recursive module subroutine from_binaryfile_1dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dr128 impure recursive module subroutine from_textfile_1dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1dr64 impure recursive module subroutine from_binaryfile_1dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dr64 impure recursive module subroutine from_textfile_1dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1dr32 impure recursive module subroutine from_binaryfile_1dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dr32 impure recursive module subroutine from_textfile_2dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2dr128 impure recursive module subroutine from_binaryfile_2dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dr128 impure recursive module subroutine from_textfile_2dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2dr64 impure recursive module subroutine from_binaryfile_2dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dr64 impure recursive module subroutine from_textfile_2dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2dr32 impure recursive module subroutine from_binaryfile_2dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dr32 impure recursive module subroutine from_file_3dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dr128 impure recursive module subroutine from_file_3dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dr64 impure recursive module subroutine from_file_3dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dr32 impure recursive module subroutine from_file_4dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dr128 impure recursive module subroutine from_file_4dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dr64 impure recursive module subroutine from_file_4dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dr32 impure recursive module subroutine from_file_5dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dr128 impure recursive module subroutine from_file_5dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dr64 impure recursive module subroutine from_file_5dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dr32 impure recursive module subroutine from_file_6dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dr128 impure recursive module subroutine from_file_6dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dr64 impure recursive module subroutine from_file_6dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dr32 impure recursive module subroutine from_file_7dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dr128 impure recursive module subroutine from_file_7dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dr64 impure recursive module subroutine from_file_7dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dr32 impure recursive module subroutine from_file_8dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dr128 impure recursive module subroutine from_file_8dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dr64 impure recursive module subroutine from_file_8dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dr32 impure recursive module subroutine from_file_9dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dr128 impure recursive module subroutine from_file_9dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dr64 impure recursive module subroutine from_file_9dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dr32 impure recursive module subroutine from_file_10dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dr128 impure recursive module subroutine from_file_10dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dr64 impure recursive module subroutine from_file_10dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dr32 impure recursive module subroutine from_file_11dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dr128 impure recursive module subroutine from_file_11dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dr64 impure recursive module subroutine from_file_11dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dr32 impure recursive module subroutine from_file_12dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dr128 impure recursive module subroutine from_file_12dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dr64 impure recursive module subroutine from_file_12dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dr32 impure recursive module subroutine from_file_13dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dr128 impure recursive module subroutine from_file_13dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dr64 impure recursive module subroutine from_file_13dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dr32 impure recursive module subroutine from_file_14dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dr128 impure recursive module subroutine from_file_14dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dr64 impure recursive module subroutine from_file_14dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dr32 impure recursive module subroutine from_file_15dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dr128 impure recursive module subroutine from_file_15dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dr64 impure recursive module subroutine from_file_15dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dr32 impure recursive module subroutine from_textfile_1di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di64 impure recursive module subroutine from_binaryfile_1di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di64 impure recursive module subroutine from_textfile_1di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di32 impure recursive module subroutine from_binaryfile_1di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di32 impure recursive module subroutine from_textfile_1di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di16 impure recursive module subroutine from_binaryfile_1di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di16 impure recursive module subroutine from_textfile_1di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di8 impure recursive module subroutine from_binaryfile_1di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di8 impure recursive module subroutine from_textfile_2di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di64 impure recursive module subroutine from_binaryfile_2di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di64 impure recursive module subroutine from_textfile_2di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di32 impure recursive module subroutine from_binaryfile_2di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di32 impure recursive module subroutine from_textfile_2di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di16 impure recursive module subroutine from_binaryfile_2di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di16 impure recursive module subroutine from_textfile_2di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di8 impure recursive module subroutine from_binaryfile_2di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di8 impure recursive module subroutine from_file_3di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di64 impure recursive module subroutine from_file_3di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di32 impure recursive module subroutine from_file_3di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di16 impure recursive module subroutine from_file_3di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di8 impure recursive module subroutine from_file_4di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di64 impure recursive module subroutine from_file_4di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di32 impure recursive module subroutine from_file_4di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di16 impure recursive module subroutine from_file_4di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di8 impure recursive module subroutine from_file_5di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di64 impure recursive module subroutine from_file_5di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di32 impure recursive module subroutine from_file_5di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di16 impure recursive module subroutine from_file_5di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di8 impure recursive module subroutine from_file_6di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di64 impure recursive module subroutine from_file_6di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di32 impure recursive module subroutine from_file_6di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di16 impure recursive module subroutine from_file_6di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di8 impure recursive module subroutine from_file_7di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di64 impure recursive module subroutine from_file_7di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di32 impure recursive module subroutine from_file_7di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di16 impure recursive module subroutine from_file_7di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di8 impure recursive module subroutine from_file_8di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di64 impure recursive module subroutine from_file_8di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di32 impure recursive module subroutine from_file_8di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di16 impure recursive module subroutine from_file_8di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di8 impure recursive module subroutine from_file_9di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di64 impure recursive module subroutine from_file_9di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di32 impure recursive module subroutine from_file_9di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di16 impure recursive module subroutine from_file_9di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di8 impure recursive module subroutine from_file_10di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di64 impure recursive module subroutine from_file_10di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di32 impure recursive module subroutine from_file_10di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di16 impure recursive module subroutine from_file_10di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di8 impure recursive module subroutine from_file_11di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di64 impure recursive module subroutine from_file_11di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di32 impure recursive module subroutine from_file_11di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di16 impure recursive module subroutine from_file_11di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di8 impure recursive module subroutine from_file_12di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di64 impure recursive module subroutine from_file_12di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di32 impure recursive module subroutine from_file_12di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di16 impure recursive module subroutine from_file_12di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di8 impure recursive module subroutine from_file_13di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di64 impure recursive module subroutine from_file_13di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di32 impure recursive module subroutine from_file_13di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di16 impure recursive module subroutine from_file_13di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di8 impure recursive module subroutine from_file_14di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di64 impure recursive module subroutine from_file_14di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di32 impure recursive module subroutine from_file_14di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di16 impure recursive module subroutine from_file_14di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di8 impure recursive module subroutine from_file_15di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di64 impure recursive module subroutine from_file_15di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di32 impure recursive module subroutine from_file_15di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di16 impure recursive module subroutine from_file_15di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di8 end interface interface echo ! Submodule text_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for writing a scalar `character` or `String` to an external text file. !! !! For a user reference, see [echo](../page/Ref/echo.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine echo_chars(substring, file_name, append, terminator) character(len=*), intent(in) :: substring character(len=*), intent(in) :: file_name logical, intent(in), optional :: append character(len=*), intent(in), optional :: terminator end subroutine echo_chars impure recursive module subroutine echo_string(substring, file_name, append, terminator) class(String), intent(in) :: substring character(len=*), intent(in) :: file_name logical, intent(in), optional :: append character(len=*), intent(in), optional :: terminator end subroutine echo_string end interface interface to_text ! Submodule text_io !-------------------------------------------------------------------------------------------------------------- !! Private interface for writing an array to an external text file. !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine to_text_1dc128(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_1dc128 impure recursive module subroutine to_text_1dc64(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_1dc64 impure recursive module subroutine to_text_1dc32(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_1dc32 impure recursive module subroutine to_text_2dc128(x, file_name, header, locale, delim, fmt, decimals, im) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_2dc128 impure recursive module subroutine to_text_2dc64(x, file_name, header, locale, delim, fmt, decimals, im) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_2dc64 impure recursive module subroutine to_text_2dc32(x, file_name, header, locale, delim, fmt, decimals, im) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_2dc32 impure recursive module subroutine to_text_1dr128(x, file_name, header, dim, locale, delim, fmt, decimals) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_1dr128 impure recursive module subroutine to_text_1dr64(x, file_name, header, dim, locale, delim, fmt, decimals) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_1dr64 impure recursive module subroutine to_text_1dr32(x, file_name, header, dim, locale, delim, fmt, decimals) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_1dr32 impure recursive module subroutine to_text_2dr128(x, file_name, header, locale, delim, fmt, decimals) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_2dr128 impure recursive module subroutine to_text_2dr64(x, file_name, header, locale, delim, fmt, decimals) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_2dr64 impure recursive module subroutine to_text_2dr32(x, file_name, header, locale, delim, fmt, decimals) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_2dr32 impure recursive module subroutine to_text_1di64(x, file_name, header, dim, delim, fmt) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di64 impure recursive module subroutine to_text_1di32(x, file_name, header, dim, delim, fmt) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di32 impure recursive module subroutine to_text_1di16(x, file_name, header, dim, delim, fmt) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di16 impure recursive module subroutine to_text_1di8(x, file_name, header, dim, delim, fmt) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di8 impure recursive module subroutine to_text_2di64(x, file_name, header, delim, fmt) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di64 impure recursive module subroutine to_text_2di32(x, file_name, header, delim, fmt) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di32 impure recursive module subroutine to_text_2di16(x, file_name, header, delim, fmt) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di16 impure recursive module subroutine to_text_2di8(x, file_name, header, delim, fmt) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di8 end interface interface from_text ! Submodule text_io !-------------------------------------------------------------------------------------------------------------- !! Private interface for reading an external text file into an array. !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine from_text_1dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_1dc128 impure recursive module subroutine from_text_1dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_1dc64 impure recursive module subroutine from_text_1dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_1dc32 impure recursive module subroutine from_text_2dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_2dc128 impure recursive module subroutine from_text_2dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_2dc64 impure recursive module subroutine from_text_2dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_2dc32 impure recursive module subroutine from_text_1dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1dr128 impure recursive module subroutine from_text_1dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1dr64 impure recursive module subroutine from_text_1dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1dr32 impure recursive module subroutine from_text_2dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2dr128 impure recursive module subroutine from_text_2dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2dr64 impure recursive module subroutine from_text_2dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2dr32 impure recursive module subroutine from_text_1di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di64 impure recursive module subroutine from_text_1di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di32 impure recursive module subroutine from_text_1di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di16 impure recursive module subroutine from_text_1di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di8 impure recursive module subroutine from_text_2di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di64 impure recursive module subroutine from_text_2di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di32 impure recursive module subroutine from_text_2di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di16 impure recursive module subroutine from_text_2di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di8 end interface interface to_binary ! Submodule binary_io !-------------------------------------------------------------------------------------------------------------- !! Private interface for writing an array to an external binary file. !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine to_binary_1dc128(x, file_name) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dc128 impure recursive module subroutine to_binary_1dc64(x, file_name) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dc64 impure recursive module subroutine to_binary_1dc32(x, file_name) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dc32 impure recursive module subroutine to_binary_2dc128(x, file_name) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dc128 impure recursive module subroutine to_binary_2dc64(x, file_name) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dc64 impure recursive module subroutine to_binary_2dc32(x, file_name) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dc32 impure recursive module subroutine to_binary_3dc128(x, file_name) complex(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dc128 impure recursive module subroutine to_binary_3dc64(x, file_name) complex(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dc64 impure recursive module subroutine to_binary_3dc32(x, file_name) complex(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dc32 impure recursive module subroutine to_binary_4dc128(x, file_name) complex(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dc128 impure recursive module subroutine to_binary_4dc64(x, file_name) complex(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dc64 impure recursive module subroutine to_binary_4dc32(x, file_name) complex(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dc32 impure recursive module subroutine to_binary_5dc128(x, file_name) complex(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dc128 impure recursive module subroutine to_binary_5dc64(x, file_name) complex(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dc64 impure recursive module subroutine to_binary_5dc32(x, file_name) complex(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dc32 impure recursive module subroutine to_binary_6dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dc128 impure recursive module subroutine to_binary_6dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dc64 impure recursive module subroutine to_binary_6dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dc32 impure recursive module subroutine to_binary_7dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dc128 impure recursive module subroutine to_binary_7dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dc64 impure recursive module subroutine to_binary_7dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dc32 impure recursive module subroutine to_binary_8dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dc128 impure recursive module subroutine to_binary_8dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dc64 impure recursive module subroutine to_binary_8dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dc32 impure recursive module subroutine to_binary_9dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dc128 impure recursive module subroutine to_binary_9dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dc64 impure recursive module subroutine to_binary_9dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dc32 impure recursive module subroutine to_binary_10dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dc128 impure recursive module subroutine to_binary_10dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dc64 impure recursive module subroutine to_binary_10dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dc32 impure recursive module subroutine to_binary_11dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dc128 impure recursive module subroutine to_binary_11dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dc64 impure recursive module subroutine to_binary_11dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dc32 impure recursive module subroutine to_binary_12dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dc128 impure recursive module subroutine to_binary_12dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dc64 impure recursive module subroutine to_binary_12dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dc32 impure recursive module subroutine to_binary_13dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dc128 impure recursive module subroutine to_binary_13dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dc64 impure recursive module subroutine to_binary_13dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dc32 impure recursive module subroutine to_binary_14dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dc128 impure recursive module subroutine to_binary_14dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dc64 impure recursive module subroutine to_binary_14dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dc32 impure recursive module subroutine to_binary_15dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dc128 impure recursive module subroutine to_binary_15dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dc64 impure recursive module subroutine to_binary_15dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dc32 impure recursive module subroutine to_binary_1dr128(x, file_name) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dr128 impure recursive module subroutine to_binary_1dr64(x, file_name) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dr64 impure recursive module subroutine to_binary_1dr32(x, file_name) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dr32 impure recursive module subroutine to_binary_2dr128(x, file_name) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dr128 impure recursive module subroutine to_binary_2dr64(x, file_name) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dr64 impure recursive module subroutine to_binary_2dr32(x, file_name) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dr32 impure recursive module subroutine to_binary_3dr128(x, file_name) real(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dr128 impure recursive module subroutine to_binary_3dr64(x, file_name) real(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dr64 impure recursive module subroutine to_binary_3dr32(x, file_name) real(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dr32 impure recursive module subroutine to_binary_4dr128(x, file_name) real(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dr128 impure recursive module subroutine to_binary_4dr64(x, file_name) real(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dr64 impure recursive module subroutine to_binary_4dr32(x, file_name) real(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dr32 impure recursive module subroutine to_binary_5dr128(x, file_name) real(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dr128 impure recursive module subroutine to_binary_5dr64(x, file_name) real(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dr64 impure recursive module subroutine to_binary_5dr32(x, file_name) real(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dr32 impure recursive module subroutine to_binary_6dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dr128 impure recursive module subroutine to_binary_6dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dr64 impure recursive module subroutine to_binary_6dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dr32 impure recursive module subroutine to_binary_7dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dr128 impure recursive module subroutine to_binary_7dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dr64 impure recursive module subroutine to_binary_7dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dr32 impure recursive module subroutine to_binary_8dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dr128 impure recursive module subroutine to_binary_8dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dr64 impure recursive module subroutine to_binary_8dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dr32 impure recursive module subroutine to_binary_9dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dr128 impure recursive module subroutine to_binary_9dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dr64 impure recursive module subroutine to_binary_9dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dr32 impure recursive module subroutine to_binary_10dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dr128 impure recursive module subroutine to_binary_10dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dr64 impure recursive module subroutine to_binary_10dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dr32 impure recursive module subroutine to_binary_11dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dr128 impure recursive module subroutine to_binary_11dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dr64 impure recursive module subroutine to_binary_11dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dr32 impure recursive module subroutine to_binary_12dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dr128 impure recursive module subroutine to_binary_12dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dr64 impure recursive module subroutine to_binary_12dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dr32 impure recursive module subroutine to_binary_13dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dr128 impure recursive module subroutine to_binary_13dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dr64 impure recursive module subroutine to_binary_13dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dr32 impure recursive module subroutine to_binary_14dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dr128 impure recursive module subroutine to_binary_14dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dr64 impure recursive module subroutine to_binary_14dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dr32 impure recursive module subroutine to_binary_15dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dr128 impure recursive module subroutine to_binary_15dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dr64 impure recursive module subroutine to_binary_15dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dr32 impure recursive module subroutine to_binary_1di64(x, file_name) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di64 impure recursive module subroutine to_binary_1di32(x, file_name) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di32 impure recursive module subroutine to_binary_1di16(x, file_name) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di16 impure recursive module subroutine to_binary_1di8(x, file_name) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di8 impure recursive module subroutine to_binary_2di64(x, file_name) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di64 impure recursive module subroutine to_binary_2di32(x, file_name) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di32 impure recursive module subroutine to_binary_2di16(x, file_name) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di16 impure recursive module subroutine to_binary_2di8(x, file_name) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di8 impure recursive module subroutine to_binary_3di64(x, file_name) integer(int64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di64 impure recursive module subroutine to_binary_3di32(x, file_name) integer(int32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di32 impure recursive module subroutine to_binary_3di16(x, file_name) integer(int16), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di16 impure recursive module subroutine to_binary_3di8(x, file_name) integer(int8), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di8 impure recursive module subroutine to_binary_4di64(x, file_name) integer(int64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di64 impure recursive module subroutine to_binary_4di32(x, file_name) integer(int32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di32 impure recursive module subroutine to_binary_4di16(x, file_name) integer(int16), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di16 impure recursive module subroutine to_binary_4di8(x, file_name) integer(int8), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di8 impure recursive module subroutine to_binary_5di64(x, file_name) integer(int64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di64 impure recursive module subroutine to_binary_5di32(x, file_name) integer(int32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di32 impure recursive module subroutine to_binary_5di16(x, file_name) integer(int16), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di16 impure recursive module subroutine to_binary_5di8(x, file_name) integer(int8), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di8 impure recursive module subroutine to_binary_6di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di64 impure recursive module subroutine to_binary_6di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di32 impure recursive module subroutine to_binary_6di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di16 impure recursive module subroutine to_binary_6di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di8 impure recursive module subroutine to_binary_7di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di64 impure recursive module subroutine to_binary_7di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di32 impure recursive module subroutine to_binary_7di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di16 impure recursive module subroutine to_binary_7di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di8 impure recursive module subroutine to_binary_8di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di64 impure recursive module subroutine to_binary_8di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di32 impure recursive module subroutine to_binary_8di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di16 impure recursive module subroutine to_binary_8di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di8 impure recursive module subroutine to_binary_9di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di64 impure recursive module subroutine to_binary_9di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di32 impure recursive module subroutine to_binary_9di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di16 impure recursive module subroutine to_binary_9di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di8 impure recursive module subroutine to_binary_10di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di64 impure recursive module subroutine to_binary_10di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di32 impure recursive module subroutine to_binary_10di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di16 impure recursive module subroutine to_binary_10di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di8 impure recursive module subroutine to_binary_11di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di64 impure recursive module subroutine to_binary_11di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di32 impure recursive module subroutine to_binary_11di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di16 impure recursive module subroutine to_binary_11di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di8 impure recursive module subroutine to_binary_12di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di64 impure recursive module subroutine to_binary_12di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di32 impure recursive module subroutine to_binary_12di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di16 impure recursive module subroutine to_binary_12di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di8 impure recursive module subroutine to_binary_13di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di64 impure recursive module subroutine to_binary_13di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di32 impure recursive module subroutine to_binary_13di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di16 impure recursive module subroutine to_binary_13di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di8 impure recursive module subroutine to_binary_14di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di64 impure recursive module subroutine to_binary_14di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di32 impure recursive module subroutine to_binary_14di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di16 impure recursive module subroutine to_binary_14di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di8 impure recursive module subroutine to_binary_15di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di64 impure recursive module subroutine to_binary_15di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di32 impure recursive module subroutine to_binary_15di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di16 impure recursive module subroutine to_binary_15di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di8 end interface interface from_binary ! Submodule binary_io !-------------------------------------------------------------------------------------------------------------- !! Private interface for reading an external binary file into an array. !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine from_binary_1dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dc128 impure recursive module subroutine from_binary_1dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dc64 impure recursive module subroutine from_binary_1dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dc32 impure recursive module subroutine from_binary_2dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dc128 impure recursive module subroutine from_binary_2dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dc64 impure recursive module subroutine from_binary_2dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dc32 impure recursive module subroutine from_binary_3dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dc128 impure recursive module subroutine from_binary_3dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dc64 impure recursive module subroutine from_binary_3dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dc32 impure recursive module subroutine from_binary_4dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dc128 impure recursive module subroutine from_binary_4dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dc64 impure recursive module subroutine from_binary_4dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dc32 impure recursive module subroutine from_binary_5dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dc128 impure recursive module subroutine from_binary_5dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dc64 impure recursive module subroutine from_binary_5dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dc32 impure recursive module subroutine from_binary_6dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dc128 impure recursive module subroutine from_binary_6dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dc64 impure recursive module subroutine from_binary_6dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dc32 impure recursive module subroutine from_binary_7dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dc128 impure recursive module subroutine from_binary_7dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dc64 impure recursive module subroutine from_binary_7dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dc32 impure recursive module subroutine from_binary_8dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dc128 impure recursive module subroutine from_binary_8dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dc64 impure recursive module subroutine from_binary_8dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dc32 impure recursive module subroutine from_binary_9dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dc128 impure recursive module subroutine from_binary_9dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dc64 impure recursive module subroutine from_binary_9dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dc32 impure recursive module subroutine from_binary_10dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dc128 impure recursive module subroutine from_binary_10dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dc64 impure recursive module subroutine from_binary_10dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dc32 impure recursive module subroutine from_binary_11dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dc128 impure recursive module subroutine from_binary_11dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dc64 impure recursive module subroutine from_binary_11dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dc32 impure recursive module subroutine from_binary_12dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dc128 impure recursive module subroutine from_binary_12dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dc64 impure recursive module subroutine from_binary_12dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dc32 impure recursive module subroutine from_binary_13dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dc128 impure recursive module subroutine from_binary_13dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dc64 impure recursive module subroutine from_binary_13dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dc32 impure recursive module subroutine from_binary_14dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dc128 impure recursive module subroutine from_binary_14dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dc64 impure recursive module subroutine from_binary_14dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dc32 impure recursive module subroutine from_binary_15dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dc128 impure recursive module subroutine from_binary_15dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dc64 impure recursive module subroutine from_binary_15dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dc32 impure recursive module subroutine from_binary_1dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dr128 impure recursive module subroutine from_binary_1dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dr64 impure recursive module subroutine from_binary_1dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dr32 impure recursive module subroutine from_binary_2dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dr128 impure recursive module subroutine from_binary_2dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dr64 impure recursive module subroutine from_binary_2dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dr32 impure recursive module subroutine from_binary_3dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dr128 impure recursive module subroutine from_binary_3dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dr64 impure recursive module subroutine from_binary_3dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dr32 impure recursive module subroutine from_binary_4dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dr128 impure recursive module subroutine from_binary_4dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dr64 impure recursive module subroutine from_binary_4dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dr32 impure recursive module subroutine from_binary_5dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dr128 impure recursive module subroutine from_binary_5dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dr64 impure recursive module subroutine from_binary_5dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dr32 impure recursive module subroutine from_binary_6dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dr128 impure recursive module subroutine from_binary_6dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dr64 impure recursive module subroutine from_binary_6dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dr32 impure recursive module subroutine from_binary_7dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dr128 impure recursive module subroutine from_binary_7dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dr64 impure recursive module subroutine from_binary_7dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dr32 impure recursive module subroutine from_binary_8dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dr128 impure recursive module subroutine from_binary_8dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dr64 impure recursive module subroutine from_binary_8dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dr32 impure recursive module subroutine from_binary_9dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dr128 impure recursive module subroutine from_binary_9dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dr64 impure recursive module subroutine from_binary_9dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dr32 impure recursive module subroutine from_binary_10dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dr128 impure recursive module subroutine from_binary_10dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dr64 impure recursive module subroutine from_binary_10dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dr32 impure recursive module subroutine from_binary_11dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dr128 impure recursive module subroutine from_binary_11dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dr64 impure recursive module subroutine from_binary_11dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dr32 impure recursive module subroutine from_binary_12dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dr128 impure recursive module subroutine from_binary_12dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dr64 impure recursive module subroutine from_binary_12dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dr32 impure recursive module subroutine from_binary_13dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dr128 impure recursive module subroutine from_binary_13dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dr64 impure recursive module subroutine from_binary_13dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dr32 impure recursive module subroutine from_binary_14dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dr128 impure recursive module subroutine from_binary_14dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dr64 impure recursive module subroutine from_binary_14dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dr32 impure recursive module subroutine from_binary_15dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dr128 impure recursive module subroutine from_binary_15dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dr64 impure recursive module subroutine from_binary_15dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dr32 impure recursive module subroutine from_binary_1di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di64 impure recursive module subroutine from_binary_1di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di32 impure recursive module subroutine from_binary_1di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di16 impure recursive module subroutine from_binary_1di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di8 impure recursive module subroutine from_binary_2di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di64 impure recursive module subroutine from_binary_2di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di32 impure recursive module subroutine from_binary_2di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di16 impure recursive module subroutine from_binary_2di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di8 impure recursive module subroutine from_binary_3di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di64 impure recursive module subroutine from_binary_3di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di32 impure recursive module subroutine from_binary_3di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di16 impure recursive module subroutine from_binary_3di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di8 impure recursive module subroutine from_binary_4di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di64 impure recursive module subroutine from_binary_4di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di32 impure recursive module subroutine from_binary_4di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di16 impure recursive module subroutine from_binary_4di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di8 impure recursive module subroutine from_binary_5di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di64 impure recursive module subroutine from_binary_5di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di32 impure recursive module subroutine from_binary_5di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di16 impure recursive module subroutine from_binary_5di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di8 impure recursive module subroutine from_binary_6di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di64 impure recursive module subroutine from_binary_6di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di32 impure recursive module subroutine from_binary_6di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di16 impure recursive module subroutine from_binary_6di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di8 impure recursive module subroutine from_binary_7di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di64 impure recursive module subroutine from_binary_7di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di32 impure recursive module subroutine from_binary_7di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di16 impure recursive module subroutine from_binary_7di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di8 impure recursive module subroutine from_binary_8di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di64 impure recursive module subroutine from_binary_8di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di32 impure recursive module subroutine from_binary_8di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di16 impure recursive module subroutine from_binary_8di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di8 impure recursive module subroutine from_binary_9di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di64 impure recursive module subroutine from_binary_9di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di32 impure recursive module subroutine from_binary_9di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di16 impure recursive module subroutine from_binary_9di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di8 impure recursive module subroutine from_binary_10di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di64 impure recursive module subroutine from_binary_10di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di32 impure recursive module subroutine from_binary_10di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di16 impure recursive module subroutine from_binary_10di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di8 impure recursive module subroutine from_binary_11di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di64 impure recursive module subroutine from_binary_11di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di32 impure recursive module subroutine from_binary_11di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di16 impure recursive module subroutine from_binary_11di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di8 impure recursive module subroutine from_binary_12di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di64 impure recursive module subroutine from_binary_12di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di32 impure recursive module subroutine from_binary_12di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di16 impure recursive module subroutine from_binary_12di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di8 impure recursive module subroutine from_binary_13di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di64 impure recursive module subroutine from_binary_13di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di32 impure recursive module subroutine from_binary_13di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di16 impure recursive module subroutine from_binary_13di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di8 impure recursive module subroutine from_binary_14di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di64 impure recursive module subroutine from_binary_14di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di32 impure recursive module subroutine from_binary_14di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di16 impure recursive module subroutine from_binary_14di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di8 impure recursive module subroutine from_binary_15di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di64 impure recursive module subroutine from_binary_15di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di32 impure recursive module subroutine from_binary_15di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di16 impure recursive module subroutine from_binary_15di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di8 end interface interface aprint ! Submodule array_printing !-------------------------------------------------------------------------------------------------------------- !! Subroutine for printing arrays and array sections to stdout. !! !! For a user reference, see [aprint](../page/Ref/aprint.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine aprint_1dc128(x, fmt, decimals, im) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_1dc128 impure recursive module subroutine aprint_1dc64(x, fmt, decimals, im) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_1dc64 impure recursive module subroutine aprint_1dc32(x, fmt, decimals, im) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_1dc32 impure recursive module subroutine aprint_2dc128(x, fmt, decimals, im) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_2dc128 impure recursive module subroutine aprint_2dc64(x, fmt, decimals, im) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_2dc64 impure recursive module subroutine aprint_2dc32(x, fmt, decimals, im) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_2dc32 impure recursive module subroutine aprint_1dr128(x, fmt, decimals) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_1dr128 impure recursive module subroutine aprint_1dr64(x, fmt, decimals) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_1dr64 impure recursive module subroutine aprint_1dr32(x, fmt, decimals) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_1dr32 impure recursive module subroutine aprint_2dr128(x, fmt, decimals) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_2dr128 impure recursive module subroutine aprint_2dr64(x, fmt, decimals) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_2dr64 impure recursive module subroutine aprint_2dr32(x, fmt, decimals) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_2dr32 impure recursive module subroutine aprint_1di64(x, fmt) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di64 impure recursive module subroutine aprint_1di32(x, fmt) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di32 impure recursive module subroutine aprint_1di16(x, fmt) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di16 impure recursive module subroutine aprint_1di8(x, fmt) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di8 impure recursive module subroutine aprint_2di64(x, fmt) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di64 impure recursive module subroutine aprint_2di32(x, fmt) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di32 impure recursive module subroutine aprint_2di16(x, fmt) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di16 impure recursive module subroutine aprint_2di8(x, fmt) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di8 impure recursive module subroutine aprint_1dchar(x) character(len=*), dimension(:), intent(in) :: x end subroutine aprint_1dchar impure recursive module subroutine aprint_2dchar(x) character(len=*), dimension(:,:), intent(in) :: x end subroutine aprint_2dchar impure recursive module subroutine aprint_1dString(x) class(String), dimension(:), intent(in) :: x end subroutine aprint_1dString impure recursive module subroutine aprint_2dString(x) class(String), dimension(:,:), intent(in) :: x end subroutine aprint_2dString end interface contains pure recursive function ext_of(file_name) result(ext) ! Function for parsing a file name for an extension character(len=*), intent(in) :: file_name character(len=:), allocatable :: ext integer :: i, l l = len_trim(file_name) do i = l, 1, -1 if ( file_name(i:i) == POINT ) exit end do if ( i > 0 ) then ext = trim(adjustl(file_name(i+1:l))) else ext = EMPTY_STR end if end function ext_of end module io_fortran_lib submodule (io_fortran_lib) string_methods !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **type-bound procedures** of type `String`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains module procedure as_str if ( self%len() < 1 ) then string_slice = EMPTY_STR else string_slice = self%s end if end procedure as_str module procedure count_substring_chars integer(int64) :: self_len, match_len, max_pos, upper_ind, i, j integer :: first_char, last_char self_len = self%len64() match_len = len(match, kind=int64) if ( self_len < 1_int64 ) then if ( self_len == match_len ) then occurrences = 1; return else occurrences = 0; return end if end if if ( (match_len == 0_int64) .or. (match_len > self_len) ) then occurrences = 0; return end if occurrences = 0; max_pos = self_len-match_len+1_int64 first_char = iachar(match(1:1)); last_char = iachar(match(match_len:match_len)) if ( match_len == 1_int64 ) then i = 1_int64; do if ( i > max_pos ) return if ( iachar(self%s(i:i)) /= first_char ) then i = i + 1_int64; cycle else occurrences = occurrences + 1; i = i + 1_int64; cycle end if end do end if if ( match_len == 2_int64 ) then i = 1_int64; do if ( i > max_pos ) return if ( iachar(self%s(i:i)) /= first_char ) then i = i + 1_int64; cycle end if if ( iachar(self%s(i+1_int64:i+1_int64)) /= last_char ) then i = i + 1_int64; cycle else occurrences = occurrences + 1; i = i + 2_int64; cycle end if end do end if i = 1_int64; do if ( i > max_pos ) return if ( iachar(self%s(i:i)) /= first_char ) then i = i + 1_int64; cycle end if upper_ind = i+match_len-1_int64 if ( iachar(self%s(upper_ind:upper_ind)) /= last_char ) then i = i + 1_int64; cycle end if if ( self%s(i:upper_ind) == match ) then occurrences = occurrences + 1; i = i + match_len; cycle else i = i + 1_int64; cycle end if end do end procedure count_substring_chars module procedure count_substring_string integer(int64) :: self_len, match_len, max_pos, upper_ind, i, j integer :: first_char, last_char self_len = self%len64() match_len = match%len64() if ( self_len < 1_int64 ) then if ( self_len == match_len ) then occurrences = 1; return else occurrences = 0; return end if end if if ( (match_len == 0_int64) .or. (match_len > self_len) ) then occurrences = 0; return end if occurrences = 0; max_pos = self_len-match_len+1_int64 first_char = iachar(match%s(1:1)); last_char = iachar(match%s(match_len:match_len)) if ( match_len == 1_int64 ) then i = 1_int64; do if ( i > max_pos ) return if ( iachar(self%s(i:i)) /= first_char ) then i = i + 1_int64; cycle else occurrences = occurrences + 1; i = i + 1_int64; cycle end if end do end if if ( match_len == 2_int64 ) then i = 1_int64; do if ( i > max_pos ) return if ( iachar(self%s(i:i)) /= first_char ) then i = i + 1_int64; cycle end if if ( iachar(self%s(i+1_int64:i+1_int64)) /= last_char ) then i = i + 1_int64; cycle else occurrences = occurrences + 1; i = i + 2_int64; cycle end if end do end if i = 1_int64; do if ( i > max_pos ) return if ( iachar(self%s(i:i)) /= first_char ) then i = i + 1_int64; cycle end if upper_ind = i+match_len-1_int64 if ( iachar(self%s(upper_ind:upper_ind)) /= last_char ) then i = i + 1_int64; cycle end if if ( self%s(i:upper_ind) == match%s ) then occurrences = occurrences + 1; i = i + match_len; cycle else i = i + 1_int64; cycle end if end do end procedure count_substring_string module procedure empty self%s = EMPTY_STR end procedure empty module procedure join_into_self type(String), dimension(2) :: token_pair character(len=:), allocatable :: separator_ integer(int64) :: num_tokens type(String) :: comp logical :: GCC num_tokens = size(tokens, kind=int64) if ( num_tokens == 1_int64 ) then if ( tokens(1_int64)%len64() < 1_int64 ) then self%s = EMPTY_STR; return else self%s = tokens(1_int64)%s; return end if end if if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if comp = String(COMPILER); GCC = ( comp%count(match='GCC') > 0 ); deallocate(comp%s) if ( num_tokens > 500_int64 ) then if ( GCC ) then call self%join(tokens=[ join(tokens(:num_tokens/2_int64), separator_), & join(tokens(1_int64+num_tokens/2_int64:), separator_) ], separator=separator_) else call token_pair(1)%join(tokens(:num_tokens/2_int64), separator_) call token_pair(2)%join(tokens(1_int64+num_tokens/2_int64:), separator_) call self%join(tokens=token_pair, separator=separator_) end if else call self%join_base(tokens=tokens, separator=separator_) end if end procedure join_into_self module procedure join_base integer(int64), dimension(size(tokens, kind=int64)) :: lengths, cumm_lengths integer(int64) :: num_tokens, sep_len, total_length, pos, i num_tokens = size(tokens, kind=int64) lengths = tokens%len64() sep_len = len(separator, kind=int64) where ( lengths == -1_int64 ) lengths = 0_int64 total_length = sum(lengths) if ( total_length == 0_int64 ) then self%s = EMPTY_STR; return end if cumm_lengths(1_int64) = 1_int64 do concurrent (i = 2_int64:num_tokens) cumm_lengths(i) = sum( lengths(:i-1_int64) ) + 1_int64 end do if ( allocated(self%s) ) deallocate(self%s) total_length = total_length + (num_tokens - 1_int64)*sep_len allocate( character(len=total_length) :: self%s ) positional_transfer: do concurrent (i = 1_int64:num_tokens) pos = cumm_lengths(i) + (i - 1_int64)*sep_len if ( lengths(i) > 0_int64 ) then self%s(pos:pos+lengths(i)-1_int64) = tokens(i)%s if ( sep_len > 0_int64 ) then if ( i < num_tokens ) self%s(pos+lengths(i):pos+lengths(i)+sep_len-1_int64) = separator end if else if ( sep_len > 0_int64 ) then if ( i < num_tokens ) self%s(pos:pos+sep_len-1_int64) = separator end if end if end do positional_transfer end procedure join_base module procedure length if ( .not. allocated(self%s) ) then self_len = -1 else self_len = len(self%s) end if end procedure length module procedure length64 if ( .not. allocated(self%s) ) then self_len = -1_int64 else self_len = len(self%s, kind=int64) end if end procedure length64 module procedure push_chars if ( self%len() < 1 ) then self%s = substring else self%s = self%s//substring end if end procedure push_chars module procedure push_string if ( self%len() < 1 ) then if ( substring%len() < 1 ) then self%s = EMPTY_STR else self%s = substring%s end if else if ( substring%len() < 1 ) then return else self%s = self%s//substring%s end if end if end procedure push_string module procedure read_file character(len=:), allocatable :: ext integer(int64) :: file_length integer :: file_unit, iostat logical :: exists ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'" in method READ_FILE. Binary data '// & 'cannot be read into a String.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'" in '// & 'method READ_FILE.'// & LF//'Supported file extensions: '//join(TEXT_EXT) end if end if inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if if ( allocated(self%s) ) deallocate(self%s) allocate( character(len=file_length) :: self%s ) read(unit=file_unit, iostat=iostat) self%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if if ( .not. present(cell_array) ) then if ( present(row_separator) ) then write(*,'(a)') LF//'WARNING: Row separator was specified in method READ_FILE for file "'// & file_name//'" without a cell array output. To use this option, '// & 'provide an actual argument to cell_array.' end if if ( present(column_separator) ) then write(*,'(a)') LF//'WARNING: Column separator was specified in method READ_FILE for file "'// & file_name//'" without a cell array output. To use this option, '// & 'provide an actual argument to cell_array.' end if return end if if ( present(row_separator) ) then if ( len(row_separator) == 0 ) then write(*,'(a)') LF//'WARNING: Cannot populate a cell array with the contents of file "'// & file_name//'" using an empty row separator. Returning without cell array...' return end if end if if ( present(column_separator) ) then if ( len(column_separator) == 0 ) then write(*,'(a)') LF//'WARNING: Cannot populate a cell array with the contents of file "'// & file_name//'" using an empty column separator. Returning without cell array...' return end if end if cell_block: block character(len=:), allocatable :: row_separator_, column_separator_ integer(int64) :: n_rows, n_cols, row, col, l, i integer :: row_sep, row_sep_len, col_sep, col_sep_len, quote, current logical :: in_quote if ( .not. present(row_separator) ) then row_separator_ = LF else row_separator_ = row_separator end if if ( .not. present(column_separator) ) then column_separator_ = COMMA else column_separator_ = column_separator end if row_sep_len = len(row_separator_); col_sep_len = len(column_separator_) row_sep = iachar(row_separator_(1:1)); col_sep = iachar(column_separator_(1:1)) quote = iachar(QQUOTE); in_quote = .false. n_rows = self%count(match=row_separator_) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(self%s(i:i)) if ( (current /= quote) .and. (current /= col_sep) .and. (current /= row_sep) ) then i = i + 1_int64; cycle end if if ( current == quote ) then in_quote = (.not. in_quote); i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_quote ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( self%s(i:i+col_sep_len-1_int64) == column_separator_ ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then if ( row_sep_len == 1 ) then exit get_n_cols else if ( self%s(i:i+row_sep_len-1_int64) == row_separator_ ) then exit get_n_cols else i = i + 1_int64; cycle end if end if end if end do get_n_cols allocate( cell_array(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(self%s(i:i)) if ( (current /= quote) .and. (current /= col_sep) .and. (current /= row_sep) ) then i = i + 1_int64; cycle end if if ( current == quote ) then in_quote = (.not. in_quote); i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_quote ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cell_array(row,col)%s = self%s(l:i-1); i = i + 1_int64; l = i; col = col + 1_int64; cycle else if ( self%s(i:i+col_sep_len-1_int64) == column_separator_ ) then cell_array(row,col)%s = self%s(l:i-1); i = i + col_sep_len; l = i; col = col+1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then if ( row_sep_len == 1 ) then cell_array(row,col)%s = self%s(l:i-1) if ( row == n_rows ) return i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle else if ( self%s(i:i+row_sep_len-1_int64) == row_separator_ ) then cell_array(row,col)%s = self%s(l:i-1) if ( row == n_rows ) return i = i + row_sep_len; l = i; col = 1_int64; row = row + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if end do positional_transfers end block cell_block end procedure read_file module procedure replace_ch_copy integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = len(substring) if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_ch_copy module procedure replace_st_copy character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = substring%len() if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_st_copy module procedure replace_chst_copy character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = substring%len() if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_chst_copy module procedure replace_stch_copy integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = len(substring) if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_stch_copy module procedure replace_ch_inplace type(String) :: new integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = len(substring) if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_ch_inplace module procedure replace_st_inplace type(String) :: new character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = substring%len() if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_st_inplace module procedure replace_chst_inplace type(String) :: new character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = substring%len() if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_chst_inplace module procedure replace_stch_inplace type(String) :: new integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = len(substring) if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_stch_inplace module procedure trim_copy if ( self%len() < 1 ) then new%s = EMPTY_STR else new%s = trim(adjustl(self%s)) end if end procedure trim_copy module procedure trim_inplace if ( self%len() < 1 ) then self%s = EMPTY_STR else self%s = trim(adjustl(self%s)) end if end procedure trim_inplace module procedure write_file character(len=:), allocatable :: ext, row_separator_, column_separator_ integer(int64), allocatable, dimension(:,:) :: lengths integer(int64) :: n_rows, n_cols, row_sep_len, col_sep_len, total_len, row, col, pos logical :: exists, append_ integer :: file_unit ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" in method WRITE_FILE'// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT) return end if if ( .not. present(row_separator) ) then row_separator_ = LF else row_separator_ = row_separator end if if ( .not. present(column_separator) ) then column_separator_ = COMMA else column_separator_ = column_separator end if if ( .not. present(append) ) then append_ = .false. else append_ = append end if n_rows = size(cell_array, dim=1, kind=int64) n_cols = size(cell_array, dim=2, kind=int64) row_sep_len = len(row_separator_, kind=int64) col_sep_len = len(column_separator_, kind=int64) if ( allocated(self%s) ) deallocate(self%s) lengths = cell_array%len64() total_len = sum(lengths) + n_rows*row_sep_len + n_rows*(n_cols - 1_int64)*col_sep_len allocate( character(len=total_len) :: self%s ) row = 1_int64; col = 1_int64; pos = 1_int64; positional_transfers: do if ( lengths(row,col) > 0_int64 ) then self%s(pos:pos+lengths(row,col)-1_int64) = cell_array(row,col)%s pos = pos + lengths(row,col) end if if ( col < n_cols ) then if ( col_sep_len > 0_int64 ) self%s(pos:pos+col_sep_len-1_int64) = column_separator_ pos = pos + col_sep_len; col = col + 1_int64; cycle else if ( row_sep_len > 0_int64 ) self%s(pos:pos+row_sep_len-1_int64) = row_separator_ if ( row < n_rows ) then pos = pos + row_sep_len; row = row + 1_int64; col = 1_int64; cycle else exit end if end if end do positional_transfers inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else if ( .not. append_ ) then open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='write', access='stream', position='append' ) end if end if write( unit=file_unit ) self%s close(file_unit) end procedure write_file module procedure write_string if ( substring%len() < 1 ) then write(unit=unit, fmt='(a)', iostat=iostat, iomsg=iomsg) EMPTY_STR else write(unit=unit, fmt='(a)', iostat=iostat, iomsg=iomsg) substring%s end if end procedure write_string module procedure scrub if ( allocated(self%s) ) deallocate(self%s) end procedure scrub end submodule string_methods submodule (io_fortran_lib) operators !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **public interfaces** `operator(//)`, !! `operator(+)`, `operator(-)`, `operator(**)`, `operator(==)`, and `operator(/=)`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains module procedure string_concatenation if ( Stringl%len() < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//Stringr%s end procedure string_concatenation module procedure string_char_concatenation if ( Stringl%len() < 1 ) then if ( len(charsr) < 1 ) then new%s = EMPTY_STR; return else new%s = charsr; return end if end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//charsr end procedure string_char_concatenation module procedure char_string_concatenation if ( len(charsl) < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = charsl; return end if new%s = charsl//Stringr%s end procedure char_string_concatenation module procedure char_concat_plus new = charsl//charsr end procedure char_concat_plus module procedure string_concat_plus if ( Stringl%len() < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//Stringr%s end procedure string_concat_plus module procedure string_char_concat_plus if ( Stringl%len() < 1 ) then if ( len(charsr) < 1 ) then new%s = EMPTY_STR; return else new%s = charsr; return end if end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//charsr end procedure string_char_concat_plus module procedure char_string_concat_plus if ( len(charsl) < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = charsl; return end if new%s = charsl//Stringr%s end procedure char_string_concat_plus module procedure char_excision type(String) :: Stringl Stringl%s = charsl if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=charsr, substring=EMPTY_STR) end procedure char_excision module procedure string_excision if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=Stringr%s, substring=EMPTY_STR) end procedure string_excision module procedure string_char_excision if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=charsr, substring=EMPTY_STR) end procedure string_char_excision module procedure char_string_excision type(String) :: Stringl Stringl%s = charsl if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=Stringr%s, substring=EMPTY_STR) end procedure char_string_excision module procedure repeat_chars new = repeat(char_base, ncopies=ncopies) end procedure repeat_chars module procedure repeat_String if ( String_base%len() < 1 ) then new%s = EMPTY_STR; return end if new%s = repeat(String_base%s, ncopies=ncopies) end procedure repeat_String module procedure string_equivalence integer :: Stringl_len, Stringr_len Stringl_len = Stringl%len() Stringr_len = Stringr%len() if ( Stringl_len /= Stringr_len ) then equal = .false.; return end if if ( Stringl_len < 1 ) then equal = .true.; return end if equal = ( Stringl%s == Stringr%s ) end procedure string_equivalence module procedure string_char_equivalence integer :: Stringl_len, charsr_len Stringl_len = Stringl%len() charsr_len = len(charsr) if ( Stringl_len /= charsr_len ) then equal = .false.; return end if if ( Stringl_len < 1 ) then equal = .true.; return end if equal = ( Stringl%s == charsr ) end procedure string_char_equivalence module procedure char_string_equivalence integer :: charsl_len, Stringr_len charsl_len = len(charsl) Stringr_len = Stringr%len() if ( charsl_len /= Stringr_len ) then equal = .false.; return end if if ( charsl_len < 1 ) then equal = .true.; return end if equal = ( charsl == Stringr%s ) end procedure char_string_equivalence module procedure string_nonequivalence integer :: Stringl_len, Stringr_len Stringl_len = Stringl%len() Stringr_len = Stringr%len() if ( Stringl_len /= Stringr_len ) then unequal = .true.; return end if if ( Stringl_len < 1 ) then unequal = .false.; return end if unequal = ( Stringl%s /= Stringr%s ) end procedure string_nonequivalence module procedure string_char_nonequivalence integer :: Stringl_len, charsr_len Stringl_len = Stringl%len() charsr_len = len(charsr) if ( Stringl_len /= charsr_len ) then unequal = .true.; return end if if ( Stringl_len < 1 ) then unequal = .false.; return end if unequal = ( Stringl%s /= charsr ) end procedure string_char_nonequivalence module procedure char_string_nonequivalence integer :: charsl_len, Stringr_len charsl_len = len(charsl) Stringr_len = Stringr%len() if ( charsl_len /= Stringr_len ) then unequal = .true.; return end if if ( charsl_len < 1 ) then unequal = .false.; return end if unequal = ( charsl /= Stringr%s ) end procedure char_string_nonequivalence end submodule operators submodule (io_fortran_lib) internal_io !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **public interfaces** `String`, `str`, and !! `cast`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) ! Submodule variables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ integer(int64), parameter :: smallest_int64 = -huge(1_int64)-1_int64 integer(int32), parameter :: smallest_int32 = -huge(1_int32)-1_int32 integer(int16), parameter :: smallest_int16 = -huge(1_int16)-1_int16 integer(int8), parameter :: smallest_int8 = -huge(1_int8)-1_int8 integer(int64), parameter :: largest_int64 = huge(1_int64) integer(int32), parameter :: largest_int32 = huge(1_int32) integer(int16), parameter :: largest_int16 = huge(1_int16) integer(int8), parameter :: largest_int8 = huge(1_int8) integer(int64), dimension(0:18), parameter :: TENS_i64 = int([ 1d0, 1d1, 1d2, 1d3, 1d4, 1d5, 1d6, 1d7, 1d8, 1d9, & 1d10, 1d11, 1d12, 1d13, 1d14, 1d15, 1d16, 1d17, & 1d18 ], kind=int64) integer(int32), dimension(0:9), parameter :: TENS_i32 = int([ 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9 ]) integer(int16), dimension(0:4), parameter :: TENS_i16 = int([ 1e0, 1e1, 1e2, 1e3, 1e4 ], kind=int16) integer(int8), dimension(0:2), parameter :: TENS_i8 = int([ 1e0, 1e1, 1e2 ], kind=int8) integer(int64), dimension(0:15), parameter :: SIXTEENS_i64 = [ 1_int64, 16_int64, 16_int64**2, 16_int64**3, & 16_int64**4, 16_int64**5, 16_int64**6, 16_int64**7,& 16_int64**8, 16_int64**9, 16_int64**10, & 16_int64**11, 16_int64**12, 16_int64**13, & 16_int64**14, 16_int64**15 ] integer(int32), dimension(0:7), parameter :: SIXTEENS_i32 = [ 1, 16, 16**2, 16**3, 16**4, 16**5, 16**6, 16**7 ] integer(int16), dimension(0:3), parameter :: SIXTEENS_i16 = [ 1_int16, 16_int16, 256_int16, 4096_int16 ] integer(int8), dimension(0:1), parameter :: SIXTEENS_i8 = [ 1_int8, 16_int8 ] character(len=1), dimension(0:15), parameter :: DIGITS_A = [ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', & 'a', 'b', 'c', 'd', 'e', 'f' ] contains ! String ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure new_string_from_c128 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re /= 0.0_real128 ) then xre_str = '0x00000000000000000000000000000000' else xre_str = '0x0'; exit if_z_re end if write(unit=xre_str(3:), fmt='(z32)') x%re do concurrent (i = 3:34) if ( (xre_str(i:i) >= 'A') .and. (xre_str(i:i) <= 'F') ) xre_str(i:i) = achar(iachar(xre_str(i:i))+32) end do end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im /= 0.0_real128 ) then xim_str = '0x00000000000000000000000000000000' else xim_str = '0x0'; exit if_z_im end if write(unit=xim_str(3:), fmt='(z32)') x%im do concurrent (i = 3:34) if ( (xim_str(i:i) >= 'A') .and. (xim_str(i:i) <= 'F') ) xim_str(i:i) = achar(iachar(xim_str(i:i))+32) end do end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real128 ) then xre_str = '0.0e+0000'; exit if_eorf_re end if if ( x%re < 0.0_real128 ) then xre_str = '00000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es44.35e4)', decimal=decimal) x%re xre_str(39:39) = 'e' else xre_str = '0000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es43.35e4)', decimal=decimal) x%re xre_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 35 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+36:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real128 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.36)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.100)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:125) = xre_str(i:124); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 36-e ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real128 ) then xim_str = '0.0e+0000'; exit if_eorf_im end if if ( x%im < 0.0_real128 ) then xim_str = '00000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es44.35e4)', decimal=decimal) x%im xim_str(39:39) = 'e' else xim_str = '0000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es43.35e4)', decimal=decimal) x%im xim_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 35 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+36:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real128 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.36)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.100)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:125) = xim_str(i:124); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 36-e ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then new%s = '('//xre_str//COMMA//xim_str//')'; return else new%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then new%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real128 ) then new%s = xre_str//xim_str//im_ else new%s = xre_str//'+'//xim_str//im_ end if end procedure new_string_from_c128 module procedure new_string_from_c64 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real64 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int64), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real64 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int64), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real64 ) then xre_str = '0.0e+000'; exit if_eorf_re end if if ( x%re < 0.0_real64 ) then xre_str = '0000000000000000000000000' write(unit=xre_str, fmt='(es25.17e3)', decimal=decimal) x%re xre_str(21:21) = 'e' else xre_str = '000000000000000000000000' write(unit=xre_str, fmt='(es24.17e3)', decimal=decimal) x%re xre_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 17 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+18:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real64 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.18)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.80)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:100) = xre_str(i:99); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 18-e ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real64 ) then xim_str = '0.0e+000'; exit if_eorf_im end if if ( x%im < 0.0_real64 ) then xim_str = '0000000000000000000000000' write(unit=xim_str, fmt='(es25.17e3)', decimal=decimal) x%im xim_str(21:21) = 'e' else xim_str = '000000000000000000000000' write(unit=xim_str, fmt='(es24.17e3)', decimal=decimal) x%im xim_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 17 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+18:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real64 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.18)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.80)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:100) = xim_str(i:99); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 18-e ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then new%s = '('//xre_str//COMMA//xim_str//')'; return else new%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then new%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real64 ) then new%s = xre_str//xim_str//im_ else new%s = xre_str//'+'//xim_str//im_ end if end procedure new_string_from_c64 module procedure new_string_from_c32 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real32 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int32), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real32 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int32), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real32 ) then xre_str = '0.0e+00'; exit if_eorf_re end if if ( x%re < 0.0_real32 ) then xre_str = '000000000000000' write(unit=xre_str, fmt='(es15.8e2)', decimal=decimal) x%re xre_str(12:12) = 'e' else xre_str = '00000000000000' write(unit=xre_str, fmt='(es14.8e2)', decimal=decimal) x%re xre_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 8 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+9:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real32 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.9)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.70)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:75) = xre_str(i:74); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 9-e ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real32 ) then xim_str = '0.0e+00'; exit if_eorf_im end if if ( x%im < 0.0_real32 ) then xim_str = '000000000000000' write(unit=xim_str, fmt='(es15.8e2)', decimal=decimal) x%im xim_str(12:12) = 'e' else xim_str = '00000000000000' write(unit=xim_str, fmt='(es14.8e2)', decimal=decimal) x%im xim_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 8 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+9:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real32 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.9)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.70)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:75) = xim_str(i:74); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 9-e ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then new%s = '('//xre_str//COMMA//xim_str//')'; return else new%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then new%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real32 ) then new%s = xre_str//xim_str//im_ else new%s = xre_str//'+'//xim_str//im_ end if end procedure new_string_from_c32 module procedure new_string_from_r128 character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x /= 0.0_real128 ) then new%s = '0x00000000000000000000000000000000' else new%s = '0x0'; return end if write(unit=new%s(3:), fmt='(z32)') x do concurrent (i = 3:34) if ( (new%s(i:i) >= 'A') .and. (new%s(i:i) <= 'F') ) new%s(i:i) = achar(iachar(new%s(i:i)) + 32) end do return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real128 ) then new%s = '0.0e+0000'; return end if if ( x < 0.0_real128 ) then new%s = '00000000000000000000000000000000000000000000' write(unit=new%s, fmt='(es44.35e4)', decimal=decimal) x new%s(39:39) = 'e' else new%s = '0000000000000000000000000000000000000000000' write(unit=new%s, fmt='(es43.35e4)', decimal=decimal) x new%s(38:38) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 35 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) then new%s = new%s(:i+decimals_)//new%s(i+36:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real128 ) then e = int(log10(abs(x))) else new%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: new%s ) if ( e > 0 ) then write(unit=new%s, fmt='(f0.36)', decimal=decimal) x else write(unit=new%s, fmt='(f0.100)', decimal=decimal) x end if i = 1; do if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (new%s(1:1) == '-') ) ) then new%s(i+1:125) = new%s(i:124); new%s(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then new%s = new%s(:i); return end if if ( .not. present(decimals) ) then new%s = new%s(:i+36-e); return end if if ( decimals <= 0 ) then new%s = new%s(:i); return end if if ( decimals >= 36-e ) then new%s = new%s(:i+36-e); return end if new%s = new%s(:i+decimals); return end if end procedure new_string_from_r128 module procedure new_string_from_r64 character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real64 ) then new%s = '0x0'; return end if inline_cast: block integer(int64) :: x_int, num, next; character(len=18) :: buffer; integer :: ascii_code logical :: negative x_int = transfer(source=x, mold=x_int) if ( x_int < 0_int64 ) then num = (x_int + 1_int64) + largest_int64; negative = .true.; buffer(1:) = '0x0000000000000000' else num = x_int; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if new%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; new%s = buffer(i-2:); return end if end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real64 ) then new%s = '0.0e+000'; return end if if ( x < 0.0_real64 ) then new%s = '0000000000000000000000000' write(unit=new%s, fmt='(es25.17e3)', decimal=decimal) x new%s(21:21) = 'e' else new%s = '000000000000000000000000' write(unit=new%s, fmt='(es24.17e3)', decimal=decimal) x new%s(20:20) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 17 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) then new%s = new%s(:i+decimals_)//new%s(i+18:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real64 ) then e = int(log10(abs(x))) else new%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: new%s ) if ( e > 0 ) then write(unit=new%s, fmt='(f0.18)', decimal=decimal) x else write(unit=new%s, fmt='(f0.80)', decimal=decimal) x end if i = 1; do if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (new%s(1:1) == '-') ) ) then new%s(i+1:100) = new%s(i:99); new%s(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then new%s = new%s(:i); return end if if ( .not. present(decimals) ) then new%s = new%s(:i+18-e); return end if if ( decimals <= 0 ) then new%s = new%s(:i); return end if if ( decimals >= 18-e ) then new%s = new%s(:i+18-e); return end if new%s = new%s(:i+decimals); return end if end procedure new_string_from_r64 module procedure new_string_from_r32 character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real32 ) then new%s = '0x0'; return end if inline_cast: block integer :: x_int, num, next; character(len=10) :: buffer; integer :: ascii_code; logical :: negative x_int = transfer(source=x, mold=x_int) if ( x_int < 0 ) then num = (x_int + 1) + largest_int32; negative = .true.; buffer(1:) = '0x00000000' else num = x_int; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if new%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; new%s = buffer(i-2:); return end if end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real32 ) then new%s = '0.0e+00'; return end if if ( x < 0.0_real32 ) then new%s = '000000000000000' write(unit=new%s, fmt='(es15.8e2)', decimal=decimal) x new%s(12:12) = 'e' else new%s = '00000000000000' write(unit=new%s, fmt='(es14.8e2)', decimal=decimal) x new%s(11:11) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 8 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) then new%s = new%s(:i+decimals_)//new%s(i+9:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real32 ) then e = int(log10(abs(x))) else new%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: new%s ) if ( e > 0 ) then write(unit=new%s, fmt='(f0.9)', decimal=decimal) x else write(unit=new%s, fmt='(f0.70)', decimal=decimal) x end if i = 1; do if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (new%s(1:1) == '-') ) ) then new%s(i+1:75) = new%s(i:74); new%s(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then new%s = new%s(:i); return end if if ( .not. present(decimals) ) then new%s = new%s(:i+9-e); return end if if ( decimals <= 0 ) then new%s = new%s(:i); return end if if ( decimals >= 9-e ) then new%s = new%s(:i+9-e); return end if new%s = new%s(:i+decimals); return end if end procedure new_string_from_r32 module procedure new_string_from_i64 character(len=1) :: fmt_ character(len=20) :: buffer integer(int64) :: num, next integer :: ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int64 ) then if ( x == smallest_int64 ) then new%s = '-9223372036854775808'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10_int64; buffer(i:i) = achar(num - 10_int64*next + 48_int64); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; new%s = buffer(i-1:); return else new%s = buffer(i:); return end if else if ( x < 0_int64 ) then num = (x + 1_int64) + largest_int64; negative = .true.; buffer(3:) = '0x0000000000000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(5:5)) if ( ascii_code < 50 ) then buffer(5:5) = achar(ascii_code + 8) else buffer(5:5) = achar(ascii_code + 47) end if new%s = buffer(3:); return else buffer(i-2:i-1) = '0x'; new%s = buffer(i-2:); return end if end if end procedure new_string_from_i64 module procedure new_string_from_i32 character(len=1) :: fmt_ character(len=11) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == smallest_int32 ) then new%s = '-2147483648'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; new%s = buffer(i-1:); return else new%s = buffer(i:); return end if else if ( x < 0 ) then num = (x + 1) + largest_int32; negative = .true.; buffer(2:) = '0x00000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(4:4)) if ( ascii_code < 50 ) then buffer(4:4) = achar(ascii_code + 8) else buffer(4:4) = achar(ascii_code + 47) end if new%s = buffer(2:); return else buffer(i-2:i-1) = '0x'; new%s = buffer(i-2:); return end if end if end procedure new_string_from_i32 module procedure new_string_from_i16 character(len=1) :: fmt_ character(len=6) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int16 ) then if ( x == smallest_int16 ) then new%s = '-32768'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; new%s = buffer(i-1:); return else new%s = buffer(i:); return end if else if ( x < 0_int16 ) then num = int((x + 1_int16) + largest_int16); negative = .true.; buffer(1:) = '0x0000' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if new%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; new%s = buffer(i-2:); return end if end if end procedure new_string_from_i16 module procedure new_string_from_i8 character(len=1) :: fmt_ character(len=4) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int8 ) then if ( x == smallest_int8 ) then new%s = '-128'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; new%s = buffer(i-1:); return else new%s = buffer(i:); return end if else if ( x < 0_int8 ) then num = int((x + 1_int8) + largest_int8); negative = .true.; buffer(1:) = '0x00' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if new%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; new%s = buffer(i-2:); return end if end if end procedure new_string_from_i8 module procedure new_string_from_string if ( x%len() < 1 ) then new%s = EMPTY_STR else new%s = x%s end if end procedure new_string_from_string module procedure new_string_from_char new%s = x end procedure new_string_from_char module procedure new_string_from_empty new%s = EMPTY_STR end procedure new_string_from_empty ! str ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure str_from_c128 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re /= 0.0_real128 ) then xre_str = '0x00000000000000000000000000000000' else xre_str = '0x0'; exit if_z_re end if write(unit=xre_str(3:), fmt='(z32)') x%re do concurrent (i = 3:34) if ( (xre_str(i:i) >= 'A') .and. (xre_str(i:i) <= 'F') ) xre_str(i:i) = achar(iachar(xre_str(i:i))+32) end do end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im /= 0.0_real128 ) then xim_str = '0x00000000000000000000000000000000' else xim_str = '0x0'; exit if_z_im end if write(unit=xim_str(3:), fmt='(z32)') x%im do concurrent (i = 3:34) if ( (xim_str(i:i) >= 'A') .and. (xim_str(i:i) <= 'F') ) xim_str(i:i) = achar(iachar(xim_str(i:i))+32) end do end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real128 ) then xre_str = '0.0e+0000'; exit if_eorf_re end if if ( x%re < 0.0_real128 ) then xre_str = '00000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es44.35e4)', decimal=decimal) x%re xre_str(39:39) = 'e' else xre_str = '0000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es43.35e4)', decimal=decimal) x%re xre_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 35 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+36:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real128 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.36)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.100)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:125) = xre_str(i:124); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 36-e ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real128 ) then xim_str = '0.0e+0000'; exit if_eorf_im end if if ( x%im < 0.0_real128 ) then xim_str = '00000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es44.35e4)', decimal=decimal) x%im xim_str(39:39) = 'e' else xim_str = '0000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es43.35e4)', decimal=decimal) x%im xim_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 35 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+36:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real128 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.36)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.100)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:125) = xim_str(i:124); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 36-e ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then x_str = '('//xre_str//COMMA//xim_str//')'; return else x_str = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then x_str = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real128 ) then x_str = xre_str//xim_str//im_ else x_str = xre_str//'+'//xim_str//im_ end if end procedure str_from_c128 module procedure str_from_c64 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real64 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int64), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real64 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int64), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real64 ) then xre_str = '0.0e+000'; exit if_eorf_re end if if ( x%re < 0.0_real64 ) then xre_str = '0000000000000000000000000' write(unit=xre_str, fmt='(es25.17e3)', decimal=decimal) x%re xre_str(21:21) = 'e' else xre_str = '000000000000000000000000' write(unit=xre_str, fmt='(es24.17e3)', decimal=decimal) x%re xre_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 17 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+18:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real64 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.18)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.80)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:100) = xre_str(i:99); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 18-e ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real64 ) then xim_str = '0.0e+000'; exit if_eorf_im end if if ( x%im < 0.0_real64 ) then xim_str = '0000000000000000000000000' write(unit=xim_str, fmt='(es25.17e3)', decimal=decimal) x%im xim_str(21:21) = 'e' else xim_str = '000000000000000000000000' write(unit=xim_str, fmt='(es24.17e3)', decimal=decimal) x%im xim_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 17 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+18:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real64 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.18)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.80)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:100) = xim_str(i:99); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 18-e ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then x_str = '('//xre_str//COMMA//xim_str//')'; return else x_str = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then x_str = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real64 ) then x_str = xre_str//xim_str//im_ else x_str = xre_str//'+'//xim_str//im_ end if end procedure str_from_c64 module procedure str_from_c32 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real32 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int32), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real32 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int32), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real32 ) then xre_str = '0.0e+00'; exit if_eorf_re end if if ( x%re < 0.0_real32 ) then xre_str = '000000000000000' write(unit=xre_str, fmt='(es15.8e2)', decimal=decimal) x%re xre_str(12:12) = 'e' else xre_str = '00000000000000' write(unit=xre_str, fmt='(es14.8e2)', decimal=decimal) x%re xre_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 8 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+9:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real32 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.9)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.70)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:75) = xre_str(i:74); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 9-e ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real32 ) then xim_str = '0.0e+00'; exit if_eorf_im end if if ( x%im < 0.0_real32 ) then xim_str = '000000000000000' write(unit=xim_str, fmt='(es15.8e2)', decimal=decimal) x%im xim_str(12:12) = 'e' else xim_str = '00000000000000' write(unit=xim_str, fmt='(es14.8e2)', decimal=decimal) x%im xim_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 8 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+9:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real32 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.9)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.70)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:75) = xim_str(i:74); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 9-e ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then x_str = '('//xre_str//COMMA//xim_str//')'; return else x_str = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then x_str = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real32 ) then x_str = xre_str//xim_str//im_ else x_str = xre_str//'+'//xim_str//im_ end if end procedure str_from_c32 module procedure str_from_r128 character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x /= 0.0_real128 ) then x_str = '0x00000000000000000000000000000000' else x_str = '0x0'; return end if write(unit=x_str(3:), fmt='(z32)') x do concurrent (i = 3:34) if ( (x_str(i:i) >= 'A') .and. (x_str(i:i) <= 'F') ) x_str(i:i) = achar(iachar(x_str(i:i)) + 32) end do return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real128 ) then x_str = '0.0e+0000'; return end if if ( x < 0.0_real128 ) then x_str = '00000000000000000000000000000000000000000000' write(unit=x_str, fmt='(es44.35e4)', decimal=decimal) x x_str(39:39) = 'e' else x_str = '0000000000000000000000000000000000000000000' write(unit=x_str, fmt='(es43.35e4)', decimal=decimal) x x_str(38:38) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 35 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) then x_str = x_str(:i+decimals_)//x_str(i+36:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real128 ) then e = int(log10(abs(x))) else x_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: x_str ) if ( e > 0 ) then write(unit=x_str, fmt='(f0.36)', decimal=decimal) x else write(unit=x_str, fmt='(f0.100)', decimal=decimal) x end if i = 1; do if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (x_str(1:1) == '-') ) ) then x_str(i+1:125) = x_str(i:124); x_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then x_str = x_str(:i); return end if if ( .not. present(decimals) ) then x_str = x_str(:i+36-e); return end if if ( decimals <= 0 ) then x_str = x_str(:i); return end if if ( decimals >= 36-e ) then x_str = x_str(:i+36-e); return end if x_str = x_str(:i+decimals); return end if end procedure str_from_r128 module procedure str_from_r64 character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real64 ) then x_str = '0x0'; return end if call cast(transfer(source=x, mold=1_int64), into=x_str, fmt='z'); return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real64 ) then x_str = '0.0e+000'; return end if if ( x < 0.0_real64 ) then x_str = '0000000000000000000000000' write(unit=x_str, fmt='(es25.17e3)', decimal=decimal) x x_str(21:21) = 'e' else x_str = '000000000000000000000000' write(unit=x_str, fmt='(es24.17e3)', decimal=decimal) x x_str(20:20) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 17 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) then x_str = x_str(:i+decimals_)//x_str(i+18:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real64 ) then e = int(log10(abs(x))) else x_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: x_str ) if ( e > 0 ) then write(unit=x_str, fmt='(f0.18)', decimal=decimal) x else write(unit=x_str, fmt='(f0.80)', decimal=decimal) x end if i = 1; do if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (x_str(1:1) == '-') ) ) then x_str(i+1:100) = x_str(i:99); x_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then x_str = x_str(:i); return end if if ( .not. present(decimals) ) then x_str = x_str(:i+18-e); return end if if ( decimals <= 0 ) then x_str = x_str(:i); return end if if ( decimals >= 18-e ) then x_str = x_str(:i+18-e); return end if x_str = x_str(:i+decimals); return end if end procedure str_from_r64 module procedure str_from_r32 character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real32 ) then x_str = '0x0'; return end if call cast(transfer(source=x, mold=1_int32), into=x_str, fmt='z'); return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real32 ) then x_str = '0.0e+00'; return end if if ( x < 0.0_real32 ) then x_str = '000000000000000' write(unit=x_str, fmt='(es15.8e2)', decimal=decimal) x x_str(12:12) = 'e' else x_str = '00000000000000' write(unit=x_str, fmt='(es14.8e2)', decimal=decimal) x x_str(11:11) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 8 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) then x_str = x_str(:i+decimals_)//x_str(i+9:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real32 ) then e = int(log10(abs(x))) else x_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: x_str ) if ( e > 0 ) then write(unit=x_str, fmt='(f0.9)', decimal=decimal) x else write(unit=x_str, fmt='(f0.70)', decimal=decimal) x end if i = 1; do if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (x_str(1:1) == '-') ) ) then x_str(i+1:75) = x_str(i:74); x_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then x_str = x_str(:i); return end if if ( .not. present(decimals) ) then x_str = x_str(:i+9-e); return end if if ( decimals <= 0 ) then x_str = x_str(:i); return end if if ( decimals >= 9-e ) then x_str = x_str(:i+9-e); return end if x_str = x_str(:i+decimals); return end if end procedure str_from_r32 module procedure str_from_i64 character(len=1) :: fmt_ character(len=20) :: buffer integer(int64) :: num, next integer :: ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int64 ) then if ( x == smallest_int64 ) then x_str = '-9223372036854775808'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10_int64; buffer(i:i) = achar(num - 10_int64*next + 48_int64); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; x_str = buffer(i-1:); return else x_str = buffer(i:); return end if else if ( x < 0_int64 ) then num = (x + 1_int64) + largest_int64; negative = .true.; buffer(3:) = '0x0000000000000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(5:5)) if ( ascii_code < 50 ) then buffer(5:5) = achar(ascii_code + 8) else buffer(5:5) = achar(ascii_code + 47) end if x_str = buffer(3:); return else buffer(i-2:i-1) = '0x'; x_str = buffer(i-2:); return end if end if end procedure str_from_i64 module procedure str_from_i32 character(len=1) :: fmt_ character(len=11) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( (any(INT_FMTS == fmt)) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == smallest_int32 ) then x_str = '-2147483648'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; x_str = buffer(i-1:); return else x_str = buffer(i:); return end if else if ( x < 0 ) then num = (x + 1) + largest_int32; negative = .true.; buffer(2:) = '0x00000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(4:4)) if ( ascii_code < 50 ) then buffer(4:4) = achar(ascii_code + 8) else buffer(4:4) = achar(ascii_code + 47) end if x_str = buffer(2:); return else buffer(i-2:i-1) = '0x'; x_str = buffer(i-2:); return end if end if end procedure str_from_i32 module procedure str_from_i16 character(len=1) :: fmt_ character(len=6) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int16 ) then if ( x == smallest_int16 ) then x_str = '-32768'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; x_str = buffer(i-1:); return else x_str = buffer(i:); return end if else if ( x < 0_int16 ) then num = int((x + 1_int16) + largest_int16); negative = .true.; buffer(1:) = '0x0000' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if x_str = buffer(1:); return else buffer(i-2:i-1) = '0x'; x_str = buffer(i-2:); return end if end if end procedure str_from_i16 module procedure str_from_i8 character(len=1) :: fmt_ character(len=4) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int8 ) then if ( x == smallest_int8 ) then x_str = '-128'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; x_str = buffer(i-1:); return else x_str = buffer(i:); return end if else if ( x < 0_int8 ) then num = int((x + 1_int8) + largest_int8); negative = .true.; buffer(1:) = '0x00' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if x_str = buffer(1:); return else buffer(i-2:i-1) = '0x'; x_str = buffer(i-2:); return end if end if end procedure str_from_i8 module procedure str_from_string if ( x%len() < 1 ) then x_str = EMPTY_STR else x_str = x%s end if end procedure str_from_string module procedure str_from_char x_str = x end procedure str_from_char module procedure str_from_empty x_str = EMPTY_STR end procedure str_from_empty ! cast ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure cast_c128_to_string character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re /= 0.0_real128 ) then xre_str = '0x00000000000000000000000000000000' else xre_str = '0x0'; exit if_z_re end if write(unit=xre_str(3:), fmt='(z32)') x%re do concurrent (i = 3:34) if ( (xre_str(i:i) >= 'A') .and. (xre_str(i:i) <= 'F') ) xre_str(i:i) = achar(iachar(xre_str(i:i))+32) end do end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im /= 0.0_real128 ) then xim_str = '0x00000000000000000000000000000000' else xim_str = '0x0'; exit if_z_im end if write(unit=xim_str(3:), fmt='(z32)') x%im do concurrent (i = 3:34) if ( (xim_str(i:i) >= 'A') .and. (xim_str(i:i) <= 'F') ) xim_str(i:i) = achar(iachar(xim_str(i:i))+32) end do end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real128 ) then xre_str = '0.0e+0000'; exit if_eorf_re end if if ( x%re < 0.0_real128 ) then xre_str = '00000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es44.35e4)', decimal=decimal) x%re xre_str(39:39) = 'e' else xre_str = '0000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es43.35e4)', decimal=decimal) x%re xre_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 35 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+36:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real128 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.36)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.100)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:125) = xre_str(i:124); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 36-e ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real128 ) then xim_str = '0.0e+0000'; exit if_eorf_im end if if ( x%im < 0.0_real128 ) then xim_str = '00000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es44.35e4)', decimal=decimal) x%im xim_str(39:39) = 'e' else xim_str = '0000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es43.35e4)', decimal=decimal) x%im xim_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 35 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+36:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real128 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.36)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.100)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:125) = xim_str(i:124); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 36-e ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then into%s = '('//xre_str//COMMA//xim_str//')'; return else into%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then into%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real128 ) then into%s = xre_str//xim_str//im_ else into%s = xre_str//'+'//xim_str//im_ end if end procedure cast_c128_to_string module procedure cast_c64_to_string character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real64 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int64), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real64 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int64), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real64 ) then xre_str = '0.0e+000'; exit if_eorf_re end if if ( x%re < 0.0_real64 ) then xre_str = '0000000000000000000000000' write(unit=xre_str, fmt='(es25.17e3)', decimal=decimal) x%re xre_str(21:21) = 'e' else xre_str = '000000000000000000000000' write(unit=xre_str, fmt='(es24.17e3)', decimal=decimal) x%re xre_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 17 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+18:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real64 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.18)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.80)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:100) = xre_str(i:99); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 18-e ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real64 ) then xim_str = '0.0e+000'; exit if_eorf_im end if if ( x%im < 0.0_real64 ) then xim_str = '0000000000000000000000000' write(unit=xim_str, fmt='(es25.17e3)', decimal=decimal) x%im xim_str(21:21) = 'e' else xim_str = '000000000000000000000000' write(unit=xim_str, fmt='(es24.17e3)', decimal=decimal) x%im xim_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 17 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+18:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real64 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.18)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.80)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:100) = xim_str(i:99); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 18-e ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then into%s = '('//xre_str//COMMA//xim_str//')'; return else into%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then into%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real64 ) then into%s = xre_str//xim_str//im_ else into%s = xre_str//'+'//xim_str//im_ end if end procedure cast_c64_to_string module procedure cast_c32_to_string character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real32 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int32), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real32 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int32), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real32 ) then xre_str = '0.0e+00'; exit if_eorf_re end if if ( x%re < 0.0_real32 ) then xre_str = '000000000000000' write(unit=xre_str, fmt='(es15.8e2)', decimal=decimal) x%re xre_str(12:12) = 'e' else xre_str = '00000000000000' write(unit=xre_str, fmt='(es14.8e2)', decimal=decimal) x%re xre_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 8 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+9:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real32 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.9)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.70)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:75) = xre_str(i:74); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 9-e ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real32 ) then xim_str = '0.0e+00'; exit if_eorf_im end if if ( x%im < 0.0_real32 ) then xim_str = '000000000000000' write(unit=xim_str, fmt='(es15.8e2)', decimal=decimal) x%im xim_str(12:12) = 'e' else xim_str = '00000000000000' write(unit=xim_str, fmt='(es14.8e2)', decimal=decimal) x%im xim_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 8 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+9:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real32 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.9)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.70)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:75) = xim_str(i:74); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 9-e ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then into%s = '('//xre_str//COMMA//xim_str//')'; return else into%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then into%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real32 ) then into%s = xre_str//xim_str//im_ else into%s = xre_str//'+'//xim_str//im_ end if end procedure cast_c32_to_string module procedure cast_r128_to_string character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x /= 0.0_real128 ) then into%s = '0x00000000000000000000000000000000' else into%s = '0x0'; return end if write(unit=into%s(3:), fmt='(z32)') x do concurrent (i = 3:34) if ( (into%s(i:i) >= 'A') .and. (into%s(i:i) <= 'F') ) into%s(i:i) = achar(iachar(into%s(i:i)) + 32) end do return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real128 ) then into%s = '0.0e+0000'; return end if if ( x < 0.0_real128 ) then into%s = '00000000000000000000000000000000000000000000' write(unit=into%s, fmt='(es44.35e4)', decimal=decimal) x into%s(39:39) = 'e' else into%s = '0000000000000000000000000000000000000000000' write(unit=into%s, fmt='(es43.35e4)', decimal=decimal) x into%s(38:38) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 35 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (into%s(i:i) == POINT) .or. (into%s(i:i) == COMMA) ) then into%s = into%s(:i+decimals_)//into%s(i+36:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real128 ) then e = int(log10(abs(x))) else into%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if if ( allocated(into%s) ) deallocate(into%s) allocate( character(len=125) :: into%s ) if ( e > 0 ) then write(unit=into%s, fmt='(f0.36)', decimal=decimal) x else write(unit=into%s, fmt='(f0.100)', decimal=decimal) x end if i = 1; do if ( (into%s(i:i) == POINT) .or. (into%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (into%s(1:1) == '-') ) ) then into%s(i+1:125) = into%s(i:124); into%s(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then into%s = into%s(:i); return end if if ( .not. present(decimals) ) then into%s = into%s(:i+36-e); return end if if ( decimals <= 0 ) then into%s = into%s(:i); return end if if ( decimals >= 36-e ) then into%s = into%s(:i+36-e); return end if into%s = into%s(:i+decimals); return end if end procedure cast_r128_to_string module procedure cast_r64_to_string character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real64 ) then into%s = '0x0'; return end if inline_cast: block integer(int64) :: x_int, num, next; character(len=18) :: buffer; integer :: ascii_code logical :: negative x_int = transfer(source=x, mold=x_int) if ( x_int < 0_int64 ) then num = (x_int + 1_int64) + largest_int64; negative = .true.; buffer(1:) = '0x0000000000000000' else num = x_int; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; into%s = buffer(i-2:); return end if end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real64 ) then into%s = '0.0e+000'; return end if if ( x < 0.0_real64 ) then into%s = '0000000000000000000000000' write(unit=into%s, fmt='(es25.17e3)', decimal=decimal) x into%s(21:21) = 'e' else into%s = '000000000000000000000000' write(unit=into%s, fmt='(es24.17e3)', decimal=decimal) x into%s(20:20) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 17 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (into%s(i:i) == POINT) .or. (into%s(i:i) == COMMA) ) then into%s = into%s(:i+decimals_)//into%s(i+18:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real64 ) then e = int(log10(abs(x))) else into%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if if ( allocated(into%s) ) deallocate(into%s) allocate( character(len=100) :: into%s ) if ( e > 0 ) then write(unit=into%s, fmt='(f0.18)', decimal=decimal) x else write(unit=into%s, fmt='(f0.80)', decimal=decimal) x end if i = 1; do if ( (into%s(i:i) == POINT) .or. (into%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (into%s(1:1) == '-') ) ) then into%s(i+1:100) = into%s(i:99); into%s(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then into%s = into%s(:i); return end if if ( .not. present(decimals) ) then into%s = into%s(:i+18-e); return end if if ( decimals <= 0 ) then into%s = into%s(:i); return end if if ( decimals >= 18-e ) then into%s = into%s(:i+18-e); return end if into%s = into%s(:i+decimals); return end if end procedure cast_r64_to_string module procedure cast_r32_to_string character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real32 ) then into%s = '0x0'; return end if inline_cast: block integer :: x_int, num, next; character(len=10) :: buffer; integer :: ascii_code; logical :: negative x_int = transfer(source=x, mold=x_int) if ( x_int < 0 ) then num = (x_int + 1) + largest_int32; negative = .true.; buffer(1:) = '0x00000000' else num = x_int; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; into%s = buffer(i-2:); return end if end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real32 ) then into%s = '0.0e+00'; return end if if ( x < 0.0_real32 ) then into%s = '000000000000000' write(unit=into%s, fmt='(es15.8e2)', decimal=decimal) x into%s(12:12) = 'e' else into%s = '00000000000000' write(unit=into%s, fmt='(es14.8e2)', decimal=decimal) x into%s(11:11) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 8 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (into%s(i:i) == POINT) .or. (into%s(i:i) == COMMA) ) then into%s = into%s(:i+decimals_)//into%s(i+9:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real32 ) then e = int(log10(abs(x))) else into%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if if ( allocated(into%s) ) deallocate(into%s) allocate( character(len=75) :: into%s ) if ( e > 0 ) then write(unit=into%s, fmt='(f0.9)', decimal=decimal) x else write(unit=into%s, fmt='(f0.70)', decimal=decimal) x end if i = 1; do if ( (into%s(i:i) == POINT) .or. (into%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (into%s(1:1) == '-') ) ) then into%s(i+1:75) = into%s(i:74); into%s(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then into%s = into%s(:i); return end if if ( .not. present(decimals) ) then into%s = into%s(:i+9-e); return end if if ( decimals <= 0 ) then into%s = into%s(:i); return end if if ( decimals >= 9-e ) then into%s = into%s(:i+9-e); return end if into%s = into%s(:i+decimals); return end if end procedure cast_r32_to_string module procedure cast_i64_to_string character(len=1) :: fmt_ character(len=20) :: buffer integer(int64) :: num, next integer :: ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int64 ) then if ( x == smallest_int64 ) then into%s = '-9223372036854775808'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10_int64; buffer(i:i) = achar(num - 10_int64*next + 48_int64); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into%s = buffer(i-1:); return else into%s = buffer(i:); return end if else if ( x < 0_int64 ) then num = (x + 1_int64) + largest_int64; negative = .true.; buffer(3:) = '0x0000000000000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(5:5)) if ( ascii_code < 50 ) then buffer(5:5) = achar(ascii_code + 8) else buffer(5:5) = achar(ascii_code + 47) end if into%s = buffer(3:); return else buffer(i-2:i-1) = '0x'; into%s = buffer(i-2:); return end if end if end procedure cast_i64_to_string module procedure cast_i32_to_string character(len=1) :: fmt_ character(len=11) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == smallest_int32 ) then into%s = '-2147483648'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into%s = buffer(i-1:); return else into%s = buffer(i:); return end if else if ( x < 0 ) then num = (x + 1) + largest_int32; negative = .true.; buffer(2:) = '0x00000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(4:4)) if ( ascii_code < 50 ) then buffer(4:4) = achar(ascii_code + 8) else buffer(4:4) = achar(ascii_code + 47) end if into%s = buffer(2:); return else buffer(i-2:i-1) = '0x'; into%s = buffer(i-2:); return end if end if end procedure cast_i32_to_string module procedure cast_i16_to_string character(len=1) :: fmt_ character(len=6) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int16 ) then if ( x == smallest_int16 ) then into%s = '-32768'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into%s = buffer(i-1:); return else into%s = buffer(i:); return end if else if ( x < 0_int16 ) then num = int((x + 1_int16) + largest_int16); negative = .true.; buffer(1:) = '0x0000' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; into%s = buffer(i-2:); return end if end if end procedure cast_i16_to_string module procedure cast_i8_to_string character(len=1) :: fmt_ character(len=4) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int8 ) then if ( x == smallest_int8 ) then into%s = '-128'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into%s = buffer(i-1:); return else into%s = buffer(i:); return end if else if ( x < 0_int8 ) then num = int((x + 1_int8) + largest_int8); negative = .true.; buffer(1:) = '0x00' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into%s = buffer(1:); return else buffer(i-2:i-1) = '0x'; into%s = buffer(i-2:); return end if end if end procedure cast_i8_to_string module procedure cast_c128_to_char character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re /= 0.0_real128 ) then xre_str = '0x00000000000000000000000000000000' else xre_str = '0x0'; exit if_z_re end if write(unit=xre_str(3:), fmt='(z32)') x%re do concurrent (i = 3:34) if ( (xre_str(i:i) >= 'A') .and. (xre_str(i:i) <= 'F') ) xre_str(i:i) = achar(iachar(xre_str(i:i))+32) end do end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im /= 0.0_real128 ) then xim_str = '0x00000000000000000000000000000000' else xim_str = '0x0'; exit if_z_im end if write(unit=xim_str(3:), fmt='(z32)') x%im do concurrent (i = 3:34) if ( (xim_str(i:i) >= 'A') .and. (xim_str(i:i) <= 'F') ) xim_str(i:i) = achar(iachar(xim_str(i:i))+32) end do end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real128 ) then xre_str = '0.0e+0000'; exit if_eorf_re end if if ( x%re < 0.0_real128 ) then xre_str = '00000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es44.35e4)', decimal=decimal) x%re xre_str(39:39) = 'e' else xre_str = '0000000000000000000000000000000000000000000' write(unit=xre_str, fmt='(es43.35e4)', decimal=decimal) x%re xre_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 35 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+36:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real128 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.36)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.100)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:125) = xre_str(i:124); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 36-e ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real128 ) then xim_str = '0.0e+0000'; exit if_eorf_im end if if ( x%im < 0.0_real128 ) then xim_str = '00000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es44.35e4)', decimal=decimal) x%im xim_str(39:39) = 'e' else xim_str = '0000000000000000000000000000000000000000000' write(unit=xim_str, fmt='(es43.35e4)', decimal=decimal) x%im xim_str(38:38) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 35 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+36:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real128 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.36)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.100)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:125) = xim_str(i:124); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 36-e ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then into = '('//xre_str//COMMA//xim_str//')'; return else into = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then into = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real128 ) then into = xre_str//xim_str//im_ else into = xre_str//'+'//xim_str//im_ end if end procedure cast_c128_to_char module procedure cast_c64_to_char character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real64 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int64), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real64 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int64), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real64 ) then xre_str = '0.0e+000'; exit if_eorf_re end if if ( x%re < 0.0_real64 ) then xre_str = '0000000000000000000000000' write(unit=xre_str, fmt='(es25.17e3)', decimal=decimal) x%re xre_str(21:21) = 'e' else xre_str = '000000000000000000000000' write(unit=xre_str, fmt='(es24.17e3)', decimal=decimal) x%re xre_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 17 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+18:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real64 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.18)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.80)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:100) = xre_str(i:99); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 18-e ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real64 ) then xim_str = '0.0e+000'; exit if_eorf_im end if if ( x%im < 0.0_real64 ) then xim_str = '0000000000000000000000000' write(unit=xim_str, fmt='(es25.17e3)', decimal=decimal) x%im xim_str(21:21) = 'e' else xim_str = '000000000000000000000000' write(unit=xim_str, fmt='(es24.17e3)', decimal=decimal) x%im xim_str(20:20) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 17 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+18:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real64 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.18)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.80)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:100) = xim_str(i:99); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 18-e ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then into = '('//xre_str//COMMA//xim_str//')'; return else into = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then into = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real64 ) then into = xre_str//xim_str//im_ else into = xre_str//'+'//xim_str//im_ end if end procedure cast_c64_to_char module procedure cast_c32_to_char character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: xre_str, xim_str, im_ integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real32 ) then xre_str = '0x0'; exit if_z_re end if call cast(transfer(source=x%re, mold=1_int32), into=xre_str, fmt='z'); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real32 ) then xim_str = '0x0'; exit if_z_im end if call cast(transfer(source=x%im, mold=1_int32), into=xim_str, fmt='z'); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real32 ) then xre_str = '0.0e+00'; exit if_eorf_re end if if ( x%re < 0.0_real32 ) then xre_str = '000000000000000' write(unit=xre_str, fmt='(es15.8e2)', decimal=decimal) x%re xre_str(12:12) = 'e' else xre_str = '00000000000000' write(unit=xre_str, fmt='(es14.8e2)', decimal=decimal) x%re xre_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 8 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+9:); exit if_eorf_re end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real32 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.9)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.70)', decimal=decimal) x%re end if i = 1; do if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:75) = xre_str(i:74); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i); exit if_eorf_re end if if ( decimals >= 9-e ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real32 ) then xim_str = '0.0e+00'; exit if_eorf_im end if if ( x%im < 0.0_real32 ) then xim_str = '000000000000000' write(unit=xim_str, fmt='(es15.8e2)', decimal=decimal) x%im xim_str(12:12) = 'e' else xim_str = '00000000000000' write(unit=xim_str, fmt='(es14.8e2)', decimal=decimal) x%im xim_str(11:11) = 'e' end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 8 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+9:); exit if_eorf_im end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real32 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.9)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.70)', decimal=decimal) x%im end if i = 1; do if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:75) = xim_str(i:74); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i); exit if_eorf_im end if if ( decimals >= 9-e ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then into = '('//xre_str//COMMA//xim_str//')'; return else into = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then into = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real32 ) then into = xre_str//xim_str//im_ else into = xre_str//'+'//xim_str//im_ end if end procedure cast_c32_to_char module procedure cast_r128_to_char character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x /= 0.0_real128 ) then into = '0x00000000000000000000000000000000' else into = '0x0'; return end if write(unit=into(3:), fmt='(z32)') x do concurrent (i = 3:34) if ( (into(i:i) >= 'A') .and. (into(i:i) <= 'F') ) into(i:i) = achar(iachar(into(i:i)) + 32) end do return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real128 ) then into = '0.0e+0000'; return end if if ( x < 0.0_real128 ) then into = '00000000000000000000000000000000000000000000' write(unit=into, fmt='(es44.35e4)', decimal=decimal) x into(39:39) = 'e' else into = '0000000000000000000000000000000000000000000' write(unit=into, fmt='(es43.35e4)', decimal=decimal) x into(38:38) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 35 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (into(i:i) == POINT) .or. (into(i:i) == COMMA) ) then into = into(:i+decimals_)//into(i+36:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real128 ) then e = int(log10(abs(x))) else into = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if if ( allocated(into) ) deallocate(into) allocate( character(len=125) :: into ) if ( e > 0 ) then write(unit=into, fmt='(f0.36)', decimal=decimal) x else write(unit=into, fmt='(f0.100)', decimal=decimal) x end if i = 1; do if ( (into(i:i) == POINT) .or. (into(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (into(1:1) == '-') ) ) then into(i+1:125) = into(i:124); into(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then into = into(:i); return end if if ( .not. present(decimals) ) then into = into(:i+36-e); return end if if ( decimals <= 0 ) then into = into(:i); return end if if ( decimals >= 36-e ) then into = into(:i+36-e); return end if into = into(:i+decimals); return end if end procedure cast_r128_to_char module procedure cast_r64_to_char character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real64 ) then into = '0x0'; return end if inline_cast: block integer(int64) :: x_int, num, next; character(len=18) :: buffer; integer :: ascii_code logical :: negative x_int = transfer(source=x, mold=x_int) if ( x_int < 0_int64 ) then num = (x_int + 1_int64) + largest_int64; negative = .true.; buffer(1:) = '0x0000000000000000' else num = x_int; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into = buffer(1:); return else buffer(i-2:i-1) = '0x'; into = buffer(i-2:); return end if end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real64 ) then into = '0.0e+000'; return end if if ( x < 0.0_real64 ) then into = '0000000000000000000000000' write(unit=into, fmt='(es25.17e3)', decimal=decimal) x into(21:21) = 'e' else into = '000000000000000000000000' write(unit=into, fmt='(es24.17e3)', decimal=decimal) x into(20:20) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 17 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (into(i:i) == POINT) .or. (into(i:i) == COMMA) ) then into = into(:i+decimals_)//into(i+18:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real64 ) then e = int(log10(abs(x))) else into = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if if ( allocated(into) ) deallocate(into) allocate( character(len=100) :: into ) if ( e > 0 ) then write(unit=into, fmt='(f0.18)', decimal=decimal) x else write(unit=into, fmt='(f0.80)', decimal=decimal) x end if i = 1; do if ( (into(i:i) == POINT) .or. (into(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (into(1:1) == '-') ) ) then into(i+1:100) = into(i:99); into(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then into = into(:i); return end if if ( .not. present(decimals) ) then into = into(:i+18-e); return end if if ( decimals <= 0 ) then into = into(:i); return end if if ( decimals >= 18-e ) then into = into(:i+18-e); return end if into = into(:i+decimals); return end if end procedure cast_r64_to_char module procedure cast_r32_to_char character(len=1) :: fmt_ character(len=5) :: decimal integer :: e, decimals_, i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real32 ) then into = '0x0'; return end if inline_cast: block integer :: x_int, num, next; character(len=10) :: buffer; integer :: ascii_code; logical :: negative x_int = transfer(source=x, mold=x_int) if ( x_int < 0 ) then num = (x_int + 1) + largest_int32; negative = .true.; buffer(1:) = '0x00000000' else num = x_int; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into = buffer(1:); return else buffer(i-2:i-1) = '0x'; into = buffer(i-2:); return end if end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real32 ) then into = '0.0e+00'; return end if if ( x < 0.0_real32 ) then into = '000000000000000' write(unit=into, fmt='(es15.8e2)', decimal=decimal) x into(12:12) = 'e' else into = '00000000000000' write(unit=into, fmt='(es14.8e2)', decimal=decimal) x into(11:11) = 'e' end if if ( .not. present(decimals) ) return if ( decimals >= 8 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if i = 1; do if ( (into(i:i) == POINT) .or. (into(i:i) == COMMA) ) then into = into(:i+decimals_)//into(i+9:); return end if i = i + 1; cycle end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real32 ) then e = int(log10(abs(x))) else into = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if if ( allocated(into) ) deallocate(into) allocate( character(len=75) :: into ) if ( e > 0 ) then write(unit=into, fmt='(f0.9)', decimal=decimal) x else write(unit=into, fmt='(f0.70)', decimal=decimal) x end if i = 1; do if ( (into(i:i) == POINT) .or. (into(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (into(1:1) == '-') ) ) then into(i+1:75) = into(i:74); into(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then into = into(:i); return end if if ( .not. present(decimals) ) then into = into(:i+9-e); return end if if ( decimals <= 0 ) then into = into(:i); return end if if ( decimals >= 9-e ) then into = into(:i+9-e); return end if into = into(:i+decimals); return end if end procedure cast_r32_to_char module procedure cast_i64_to_char character(len=1) :: fmt_ character(len=20) :: buffer integer(int64) :: num, next integer :: ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int64 ) then if ( x == smallest_int64 ) then into = '-9223372036854775808'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10_int64; buffer(i:i) = achar(num - 10_int64*next + 48_int64); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into = buffer(i-1:); return else into = buffer(i:); return end if else if ( x < 0_int64 ) then num = (x + 1_int64) + largest_int64; negative = .true.; buffer(3:) = '0x0000000000000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16_int64; buffer(i:i) = DIGITS_A(num - 16_int64*next); if ( next == 0_int64 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(5:5)) if ( ascii_code < 50 ) then buffer(5:5) = achar(ascii_code + 8) else buffer(5:5) = achar(ascii_code + 47) end if into = buffer(3:); return else buffer(i-2:i-1) = '0x'; into = buffer(i-2:); return end if end if end procedure cast_i64_to_char module procedure cast_i32_to_char character(len=1) :: fmt_ character(len=11) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == smallest_int32 ) then into = '-2147483648'; return end if num = -x; negative = .true. else num = x; negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into = buffer(i-1:); return else into = buffer(i:); return end if else if ( x < 0 ) then num = (x + 1) + largest_int32; negative = .true.; buffer(2:) = '0x00000000' else num = x; negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(4:4)) if ( ascii_code < 50 ) then buffer(4:4) = achar(ascii_code + 8) else buffer(4:4) = achar(ascii_code + 47) end if into = buffer(2:); return else buffer(i-2:i-1) = '0x'; into = buffer(i-2:); return end if end if end procedure cast_i32_to_char module procedure cast_i16_to_char character(len=1) :: fmt_ character(len=6) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int16 ) then if ( x == smallest_int16 ) then into = '-32768'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into = buffer(i-1:); return else into = buffer(i:); return end if else if ( x < 0_int16 ) then num = int((x + 1_int16) + largest_int16); negative = .true.; buffer(1:) = '0x0000' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into = buffer(1:); return else buffer(i-2:i-1) = '0x'; into = buffer(i-2:); return end if end if end procedure cast_i16_to_char module procedure cast_i8_to_char character(len=1) :: fmt_ character(len=4) :: buffer integer :: num, next, ascii_code, i logical :: negative if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0_int8 ) then if ( x == smallest_int8 ) then into = '-128'; return end if num = int(-x); negative = .true. else num = int(x); negative = .false. end if i = len(buffer); extract_digits: do next = num/10; buffer(i:i) = achar(num - 10*next + 48); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_digits if ( negative ) then buffer(i-1:i-1) = '-'; into = buffer(i-1:); return else into = buffer(i:); return end if else if ( x < 0_int8 ) then num = int((x + 1_int8) + largest_int8); negative = .true.; buffer(1:) = '0x00' else num = int(x); negative = .false. end if i = len(buffer); extract_hex_digits: do next = num/16; buffer(i:i) = DIGITS_A(num - 16*next); if ( next == 0 ) exit num = next; i = i - 1; cycle end do extract_hex_digits if ( negative ) then ascii_code = iachar(buffer(3:3)) if ( ascii_code < 50 ) then buffer(3:3) = achar(ascii_code + 8) else buffer(3:3) = achar(ascii_code + 47) end if into = buffer(1:); return else buffer(i-2:i-1) = '0x'; into = buffer(i-2:); return end if end if end procedure cast_i8_to_char module procedure cast_string_to_c128 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: im_ real(real128) :: z_re, z_im integer :: substring_len, l, r, i, sep_code, e_code, im_len substring_len = substring%len() if ( substring_len < 1 ) then into = (0.0_real128,0.0_real128); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real128,0.0_real128); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real128,0.0_real128); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then sep_code = iachar(COMMA) else sep_code = iachar(SEMICOLON) end if l = 1; do if ( iachar(substring%s(l:l)) == 40 ) exit l = l + 1; cycle end do r = substring_len; do if ( iachar(substring%s(r:r)) == 41 ) exit r = r - 1; cycle end do i = l+1; do if ( iachar(substring%s(i:i)) == sep_code ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then if ( i-l-1 > 2 ) then if ( substring%s(l+1:l+2) == '0x' ) then read(unit=substring%s(l+3:i-1), fmt='(z100)') z_re else read(unit=substring%s(l+1:i-1), fmt='(z100)') z_re end if else read(unit=substring%s(l+1:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring%s(i+1:i+2) == '0x' ) then read(unit=substring%s(i+3:r-1), fmt='(z100)') z_im else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring%s(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end if sep_code = iachar('+'); e_code = iachar('e'); im_len = len(im_) l = 1; do if ( iachar(substring%s(l:l)) > sep_code ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do if ( substring%s(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do if ( fmt_ == 'z' ) then i = l+1; do if ( iachar(substring%s(i:i)) == sep_code ) exit i = i + 1; cycle end do else i = l+1; do if ( (iachar(substring%s(i:i)) == sep_code) .or. (iachar(substring%s(i:i)) == sep_code+2) ) then if ( (iachar(substring%s(i-1:i-1)) == e_code).or.(iachar(substring%s(i-1:i-1)) == e_code-32) ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do end if if ( fmt_ == 'z' ) then if ( i-l > 2 ) then if ( substring%s(l:l+1) == '0x' ) then read(unit=substring%s(l+2:i-1), fmt='(z100)') z_re else read(unit=substring%s(l:i-1), fmt='(z100)') z_re end if else read(unit=substring%s(l:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring%s(i+1:i+2) == '0x' ) then read(unit=substring%s(i+3:r-1), fmt='(z100)') z_im else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring%s(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end procedure cast_string_to_c128 module procedure cast_string_to_c64 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: im_ real(real64) :: z_re, z_im integer :: substring_len, l, r, i, sep_code, e_code, im_len substring_len = substring%len() if ( substring_len < 1 ) then into = (0.0_real64,0.0_real64); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real64,0.0_real64); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real64,0.0_real64); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then sep_code = iachar(COMMA) else sep_code = iachar(SEMICOLON) end if l = 1; do if ( iachar(substring%s(l:l)) == 40 ) exit l = l + 1; cycle end do r = substring_len; do if ( iachar(substring%s(r:r)) == 41 ) exit r = r - 1; cycle end do i = l+1; do if ( iachar(substring%s(i:i)) == sep_code ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int64) :: num; character(len=i-l-1) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring%s(l+1:i-1); hex_str_im = substring%s(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring%s(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end if sep_code = iachar('+'); e_code = iachar('e'); im_len = len(im_) l = 1; do if ( iachar(substring%s(l:l)) > sep_code ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do if ( substring%s(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do if ( fmt_ == 'z' ) then i = l+1; do if ( iachar(substring%s(i:i)) == sep_code ) exit i = i + 1; cycle end do else i = l+1; do if ( (iachar(substring%s(i:i)) == sep_code) .or. (iachar(substring%s(i:i)) == sep_code+2) ) then if ( (iachar(substring%s(i-1:i-1)) == e_code).or.(iachar(substring%s(i-1:i-1)) == e_code-32) ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do end if if ( fmt_ == 'z' ) then block; integer(int64) :: num; character(len=i-l) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring%s(l:i-1); hex_str_im = substring%s(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring%s(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end procedure cast_string_to_c64 module procedure cast_string_to_c32 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: im_ real(real32) :: z_re, z_im integer :: substring_len, l, r, i, sep_code, e_code, im_len substring_len = substring%len() if ( substring_len < 1 ) then into = (0.0_real32,0.0_real32); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real32,0.0_real32); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real32,0.0_real32); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then sep_code = iachar(COMMA) else sep_code = iachar(SEMICOLON) end if l = 1; do if ( iachar(substring%s(l:l)) == 40 ) exit l = l + 1; cycle end do r = substring_len; do if ( iachar(substring%s(r:r)) == 41 ) exit r = r - 1; cycle end do i = l+1; do if ( iachar(substring%s(i:i)) == sep_code ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer :: num; character(len=i-l-1) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring%s(l+1:i-1); hex_str_im = substring%s(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring%s(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end if sep_code = iachar('+'); e_code = iachar('e'); im_len = len(im_) l = 1; do if ( iachar(substring%s(l:l)) > sep_code ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do if ( substring%s(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do if ( fmt_ == 'z' ) then i = l+1; do if ( iachar(substring%s(i:i)) == sep_code ) exit i = i + 1; cycle end do else i = l+1; do if ( (iachar(substring%s(i:i)) == sep_code) .or. (iachar(substring%s(i:i)) == sep_code+2) ) then if ( (iachar(substring%s(i-1:i-1)) == e_code).or.(iachar(substring%s(i-1:i-1)) == e_code-32) ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do end if if ( fmt_ == 'z' ) then block; integer :: num; character(len=i-l) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring%s(l:i-1); hex_str_im = substring%s(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring%s(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end procedure cast_string_to_c32 module procedure cast_string_to_r128 character(len=1) :: fmt_ character(len=5) :: decimal if ( substring%len() < 1 ) then into = 0.0_real128; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real128; return end if end if if ( fmt_ == 'z' ) then if ( substring%len() > 2 ) then if ( substring%s(1:2) == '0x' ) then read(unit=substring%s(3:), fmt='(z100)') into; return else read(unit=substring%s, fmt='(z100)') into; return end if else read(unit=substring%s, fmt='(z100)') into; return end if end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real128; return end if end if read(unit=substring%s, fmt=*, decimal=decimal) into end procedure cast_string_to_r128 module procedure cast_string_to_r64 character(len=1) :: fmt_ character(len=5) :: decimal if ( substring%len() < 1 ) then into = 0.0_real64; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real64; return end if end if if ( fmt_ == 'z' ) then inline_cast: block; integer(int64) :: num; integer :: substring_len, r, l, i, digit; logical ::negative substring_len = substring%len() r = substring_len; do if ( (iachar(substring%s(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring%s(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 16) .and. (iachar(substring%s(l:l)) > 55) ) then negative = .true. else negative = .false. end if num = 0_int64 do i = 0, ubound(SIXTEENS_i64, dim=1) digit = iachar(substring%s(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then num = num + int(digit,int64)*SIXTEENS_i64(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; num = num + int(digit,int64)*SIXTEENS_i64(i) num = (num - 1_int64) - largest_int64 into = transfer(source=num, mold=into); return else num = num + int(digit,int64)*SIXTEENS_i64(i) into = transfer(source=num, mold=into); return end if end if end do end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real64; return end if end if read(unit=substring%s, fmt=*, decimal=decimal) into end procedure cast_string_to_r64 module procedure cast_string_to_r32 character(len=1) :: fmt_ character(len=5) :: decimal if ( substring%len() < 1 ) then into = 0.0_real32; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real32; return end if end if if ( fmt_ == 'z' ) then inline_cast: block; integer :: num, substring_len, r, l, i, digit; logical :: negative substring_len = substring%len() r = substring_len; do if ( (iachar(substring%s(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring%s(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 8) .and. (iachar(substring%s(l:l)) > 55) ) then negative = .true. else negative = .false. end if num = 0 do i = 0, ubound(SIXTEENS_i32, dim=1) digit = iachar(substring%s(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then num = num + digit*SIXTEENS_i32(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; num = num + digit*SIXTEENS_i32(i) num = (num - 1) - largest_int32 into = transfer(source=num, mold=into); return else num = num + digit*SIXTEENS_i32(i) into = transfer(source=num, mold=into); return end if end if end do end block inline_cast end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real32; return end if end if read(unit=substring%s, fmt=*, decimal=decimal) into end procedure cast_string_to_r32 module procedure cast_string_to_i64 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int64; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int64; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring%s(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring%s(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int64 do i = 0, ubound(TENS_i64, dim=1) into = into + int(iachar(substring%s(r:r)) - 48,int64)*TENS_i64(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring%s(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring%s(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 16) .and. (iachar(substring%s(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0_int64 do i = 0, ubound(SIXTEENS_i64, dim=1) digit = iachar(substring%s(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + int(digit,int64)*SIXTEENS_i64(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + int(digit,int64)*SIXTEENS_i64(i) into = (into - 1_int64) - largest_int64; return else into = into + int(digit,int64)*SIXTEENS_i64(i); return end if end if end do end if end procedure cast_string_to_i64 module procedure cast_string_to_i32 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int32; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int32; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring%s(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring%s(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0 do i = 0, ubound(TENS_i32, dim=1) into = into + (iachar(substring%s(r:r)) - 48)*TENS_i32(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring%s(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring%s(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 8) .and. (iachar(substring%s(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0 do i = 0, ubound(SIXTEENS_i32, dim=1) digit = iachar(substring%s(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + digit*SIXTEENS_i32(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + digit*SIXTEENS_i32(i) into = (into - 1) - largest_int32; return else into = into + digit*SIXTEENS_i32(i); return end if end if end do end if end procedure cast_string_to_i32 module procedure cast_string_to_i16 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int16; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int16; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring%s(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring%s(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int16 do i = 0, ubound(TENS_i16, dim=1) into = into + int(iachar(substring%s(r:r)) - 48,int16)*TENS_i16(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring%s(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring%s(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 4) .and. (iachar(substring%s(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0_int16 do i = 0, ubound(SIXTEENS_i16, dim=1) digit = iachar(substring%s(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + int(digit,int16)*SIXTEENS_i16(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + int(digit,int16)*SIXTEENS_i16(i) into = (into - 1_int16) - largest_int16; return else into = into + int(digit,int16)*SIXTEENS_i16(i); return end if end if end do end if end procedure cast_string_to_i16 module procedure cast_string_to_i8 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int8; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int8; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring%s(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring%s(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int8 do i = 0, ubound(TENS_i16, dim=1) into = into + int(iachar(substring%s(r:r)) - 48,int16)*TENS_i16(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring%s(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring%s(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring%s(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 2) .and. (iachar(substring%s(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0_int8 do i = 0, ubound(SIXTEENS_i8, dim=1) digit = iachar(substring%s(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + int(digit,int8)*SIXTEENS_i8(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + int(digit,int8)*SIXTEENS_i8(i) into = (into - 1_int8) - largest_int8; return else into = into + int(digit,int8)*SIXTEENS_i8(i); return end if end if end do end if end procedure cast_string_to_i8 module procedure cast_char_to_c128 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: im_ real(real128) :: z_re, z_im integer :: substring_len, l, r, i, sep_code, e_code, im_len substring_len = len(substring) if ( substring_len < 1 ) then into = (0.0_real128,0.0_real128); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real128,0.0_real128); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real128,0.0_real128); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then sep_code = iachar(COMMA) else sep_code = iachar(SEMICOLON) end if l = 1; do if ( iachar(substring(l:l)) == 40 ) exit l = l + 1; cycle end do r = substring_len; do if ( iachar(substring(r:r)) == 41 ) exit r = r - 1; cycle end do i = l+1; do if ( iachar(substring(i:i)) == sep_code ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then if ( i-l-1 > 2 ) then if ( substring(l+1:l+2) == '0x' ) then read(unit=substring(l+3:i-1), fmt='(z100)') z_re else read(unit=substring(l+1:i-1), fmt='(z100)') z_re end if else read(unit=substring(l+1:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring(i+1:i+2) == '0x' ) then read(unit=substring(i+3:r-1), fmt='(z100)') z_im else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end if sep_code = iachar('+'); e_code = iachar('e'); im_len = len(im_) l = 1; do if ( iachar(substring(l:l)) > sep_code ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do if ( substring(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do if ( fmt_ == 'z' ) then i = l+1; do if ( iachar(substring(i:i)) == sep_code ) exit i = i + 1; cycle end do else i = l+1; do if ( (iachar(substring(i:i)) == sep_code) .or. (iachar(substring(i:i)) == sep_code+2) ) then if ( (iachar(substring(i-1:i-1)) == e_code).or.(iachar(substring(i-1:i-1)) == e_code-32) ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do end if if ( fmt_ == 'z' ) then if ( i-l > 2 ) then if ( substring(l:l+1) == '0x' ) then read(unit=substring(l+2:i-1), fmt='(z100)') z_re else read(unit=substring(l:i-1), fmt='(z100)') z_re end if else read(unit=substring(l:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring(i+1:i+2) == '0x' ) then read(unit=substring(i+3:r-1), fmt='(z100)') z_im else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end procedure cast_char_to_c128 module procedure cast_char_to_c64 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: im_ real(real64) :: z_re, z_im integer :: substring_len, l, r, i, sep_code, e_code, im_len substring_len = len(substring) if ( substring_len < 1 ) then into = (0.0_real64,0.0_real64); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real64,0.0_real64); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real64,0.0_real64); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then sep_code = iachar(COMMA) else sep_code = iachar(SEMICOLON) end if l = 1; do if ( iachar(substring(l:l)) == 40 ) exit l = l + 1; cycle end do r = substring_len; do if ( iachar(substring(r:r)) == 41 ) exit r = r - 1; cycle end do i = l+1; do if ( iachar(substring(i:i)) == sep_code ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int64) :: num; character(len=i-l-1) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring(l+1:i-1); hex_str_im = substring(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end if sep_code = iachar('+'); e_code = iachar('e'); im_len = len(im_) l = 1; do if ( iachar(substring(l:l)) > sep_code ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do if ( substring(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do if ( fmt_ == 'z' ) then i = l+1; do if ( iachar(substring(i:i)) == sep_code ) exit i = i + 1; cycle end do else i = l+1; do if ( (iachar(substring(i:i)) == sep_code) .or. (iachar(substring(i:i)) == sep_code+2) ) then if ( (iachar(substring(i-1:i-1)) == e_code).or.(iachar(substring(i-1:i-1)) == e_code-32) ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do end if if ( fmt_ == 'z' ) then block; integer(int64) :: num; character(len=i-l) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring(l:i-1); hex_str_im = substring(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end procedure cast_char_to_c64 module procedure cast_char_to_c32 character(len=1) :: fmt_ character(len=5) :: decimal character(len=:), allocatable :: im_ real(real32) :: z_re, z_im integer :: substring_len, l, r, i, sep_code, e_code, im_len substring_len = len(substring) if ( substring_len < 1 ) then into = (0.0_real32,0.0_real32); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real32,0.0_real32); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real32,0.0_real32); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then sep_code = iachar(COMMA) else sep_code = iachar(SEMICOLON) end if l = 1; do if ( iachar(substring(l:l)) == 40 ) exit l = l + 1; cycle end do r = substring_len; do if ( iachar(substring(r:r)) == 41 ) exit r = r - 1; cycle end do i = l+1; do if ( iachar(substring(i:i)) == sep_code ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer :: num; character(len=i-l-1) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring(l+1:i-1); hex_str_im = substring(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end if sep_code = iachar('+'); e_code = iachar('e'); im_len = len(im_) l = 1; do if ( iachar(substring(l:l)) > sep_code ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do if ( substring(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do if ( fmt_ == 'z' ) then i = l+1; do if ( iachar(substring(i:i)) == sep_code ) exit i = i + 1; cycle end do else i = l+1; do if ( (iachar(substring(i:i)) == sep_code) .or. (iachar(substring(i:i)) == sep_code+2) ) then if ( (iachar(substring(i-1:i-1)) == e_code).or.(iachar(substring(i-1:i-1)) == e_code-32) ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do end if if ( fmt_ == 'z' ) then block; integer :: num; character(len=i-l) :: hex_str_re; character(len=r-i-1) :: hex_str_im hex_str_re = substring(l:i-1); hex_str_im = substring(i+1:r-1) call cast(hex_str_re, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(hex_str_im, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end procedure cast_char_to_c32 module procedure cast_char_to_r128 character(len=1) :: fmt_ character(len=5) :: decimal if ( len(substring) < 1 ) then into = 0.0_real128; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real128; return end if end if if ( fmt_ == 'z' ) then if ( len(substring) > 2 ) then if ( substring(1:2) == '0x' ) then read(unit=substring(3:), fmt='(z100)') into; return else read(unit=substring, fmt='(z100)') into; return end if else read(unit=substring, fmt='(z100)') into; return end if end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real128; return end if end if read(unit=substring, fmt=*, decimal=decimal) into end procedure cast_char_to_r128 module procedure cast_char_to_r64 character(len=1) :: fmt_ character(len=5) :: decimal if ( len(substring) < 1 ) then into = 0.0_real64; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real64; return end if end if if ( fmt_ == 'z' ) then block; integer(int64) :: num call cast(substring, into=num, fmt='z'); into = transfer(source=num, mold=into); return end block end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real64; return end if end if read(unit=substring, fmt=*, decimal=decimal) into end procedure cast_char_to_r64 module procedure cast_char_to_r32 character(len=1) :: fmt_ character(len=5) :: decimal if ( len(substring) < 1 ) then into = 0.0_real32; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real32; return end if end if if ( fmt_ == 'z' ) then block; integer(int32) :: num call cast(substring, into=num, fmt='z'); into = transfer(source=num, mold=into); return end block end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real32; return end if end if read(unit=substring, fmt=*, decimal=decimal) into end procedure cast_char_to_r32 module procedure cast_char_to_i64 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int64; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int64; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int64 do i = 0, ubound(TENS_i64, dim=1) into = into + int(iachar(substring(r:r)) - 48,int64)*TENS_i64(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 16) .and. (iachar(substring(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0_int64 do i = 0, ubound(SIXTEENS_i64, dim=1) digit = iachar(substring(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + int(digit,int64)*SIXTEENS_i64(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + int(digit,int64)*SIXTEENS_i64(i) into = (into - 1_int64) - largest_int64; return else into = into + int(digit,int64)*SIXTEENS_i64(i); return end if end if end do end if end procedure cast_char_to_i64 module procedure cast_char_to_i32 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int32; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int32; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0 do i = 0, ubound(TENS_i32, dim=1) into = into + (iachar(substring(r:r)) - 48)*TENS_i32(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 8) .and. (iachar(substring(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0 do i = 0, ubound(SIXTEENS_i32, dim=1) digit = iachar(substring(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + digit*SIXTEENS_i32(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + digit*SIXTEENS_i32(i) into = (into - 1) - largest_int32; return else into = into + digit*SIXTEENS_i32(i); return end if end if end do end if end procedure cast_char_to_i32 module procedure cast_char_to_i16 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int16; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int16; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int16 do i = 0, ubound(TENS_i16, dim=1) into = into + int(iachar(substring(r:r)) - 48,int16)*TENS_i16(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 4) .and. (iachar(substring(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0_int16 do i = 0, ubound(SIXTEENS_i16, dim=1) digit = iachar(substring(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + int(digit,int16)*SIXTEENS_i16(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + int(digit,int16)*SIXTEENS_i16(i) into = (into - 1_int16) - largest_int16; return else into = into + int(digit,int16)*SIXTEENS_i16(i); return end if end if end do end if end procedure cast_char_to_i16 module procedure cast_char_to_i8 character(len=1) :: fmt_ integer :: substring_len, r, l, i, digit logical :: negative substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int8; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int8; return end if end if if ( fmt_ == 'i' ) then r = substring_len; do if ( (iachar(substring(r:r)) > 44) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 44) .or. (l == substring_len) ) exit l = l + 1; cycle end do if ( iachar(substring(l:l)) == 45 ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int8 do i = 0, ubound(TENS_i16, dim=1) into = into + int(iachar(substring(r:r)) - 48,int16)*TENS_i16(i); if ( r == l ) exit r = r - 1; cycle end do if ( .not. negative ) return into = -into; return else r = substring_len; do if ( (iachar(substring(r:r)) > 47) .or. (r == 1) ) exit r = r - 1; cycle end do l = 1; do if ( (iachar(substring(l:l)) > 47) .or. (l == substring_len) ) then if ( r-l+1 > 2 ) then if ( iachar(substring(l+1:l+1)) == 120 ) l = l + 2 end if exit end if l = l + 1; cycle end do if ( (r-l+1 == 2) .and. (iachar(substring(l:l)) > 55) ) then negative = .true. else negative = .false. end if into = 0_int8 do i = 0, ubound(SIXTEENS_i8, dim=1) digit = iachar(substring(r:r)) - 48 if ( digit > 16 ) then if ( digit < 23 ) then digit = digit - 7 else digit = digit - 39 end if end if if ( r > l ) then into = into + int(digit,int8)*SIXTEENS_i8(i); r = r - 1; cycle else if ( negative ) then digit = digit - 8; into = into + int(digit,int8)*SIXTEENS_i8(i) into = (into - 1_int8) - largest_int8; return else into = into + int(digit,int8)*SIXTEENS_i8(i); return end if end if end do end if end procedure cast_char_to_i8 end submodule internal_io submodule (io_fortran_lib) join_split !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **public interfaces** `join` and `split`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains module procedure join_char type(String) :: temp_String character(len=:), allocatable :: separator_ if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if temp_String = join(String(tokens), separator=separator_) if ( temp_String%len() < 1 ) then new = EMPTY_STR else new = temp_String%s end if end procedure join_char module procedure join_string type(String), dimension(2) :: token_pair character(len=:), allocatable :: separator_ integer(int64) :: num_tokens num_tokens = size(tokens, kind=int64) if ( num_tokens == 1_int64 ) then if ( tokens(1_int64)%len64() < 1_int64 ) then new%s = EMPTY_STR; return else new%s = tokens(1_int64)%s; return end if end if if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if if ( num_tokens > 500_int64 ) then new = join(tokens=[ join(tokens(:num_tokens/2_int64), separator_), & join(tokens(1_int64+num_tokens/2_int64:), separator_) ], separator=separator_) else call new%join_base(tokens=tokens, separator=separator_) end if end procedure join_string module procedure split_char character(len=:), allocatable :: separator_ if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if tokens = split(String(substring), separator=separator_) end procedure split_char module procedure split_string character(len=:), allocatable :: separator_ integer(int64) :: substring_len, l, i integer :: sep_len, num_seps, sep, token, current substring_len = substring%len64() if ( substring_len < 1_int64 ) then allocate( tokens(1) ); tokens(1)%s = EMPTY_STR; return end if if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if sep_len = len(separator_) if ( sep_len == 0 ) then allocate( tokens(substring_len) ) do concurrent (i = 1_int64:substring_len) tokens(i)%s = substring%s(i:i) end do return end if num_seps = substring%count(match=separator_) if ( num_seps == 0 ) then allocate( tokens(1) ); tokens(1)%s = substring%s; return end if allocate( tokens(num_seps + 1) ) sep = iachar(separator_(1:1)) i = 1_int64; l = 1_int64; token = 1; positional_transfers: do current = iachar(substring%s(i:i)) if ( current /= sep ) then i = i + 1_int64; cycle end if if ( sep_len == 1 ) then tokens(token)%s = substring%s(l:i-1) if ( token == num_seps ) then tokens(num_seps+1)%s = substring%s(i+1:); return end if token = token + 1; i = i + 1_int64; l = i; cycle else if ( substring%s(i:i+sep_len-1) == separator_ ) then tokens(token)%s = substring%s(l:i-1) if ( token == num_seps ) then tokens(num_seps+1)%s = substring%s(i+sep_len:); return end if token = token + 1; i = i + sep_len; l = i; cycle else i = i + 1_int64; cycle end if end if end do positional_transfers end procedure split_string end submodule join_split submodule (io_fortran_lib) file_io !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **public interfaces** `to_file` and !! `from_file`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains ! Writing Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure to_file_1dc128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dc128 module procedure to_file_1dc64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dc64 module procedure to_file_1dc32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dc32 module procedure to_file_2dc128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dc128 module procedure to_file_2dc64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dc64 module procedure to_file_2dc32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dc32 module procedure to_file_3dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dc128 module procedure to_file_3dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dc64 module procedure to_file_3dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dc32 module procedure to_file_4dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dc128 module procedure to_file_4dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dc64 module procedure to_file_4dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dc32 module procedure to_file_5dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dc128 module procedure to_file_5dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dc64 module procedure to_file_5dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dc32 module procedure to_file_6dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dc128 module procedure to_file_6dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dc64 module procedure to_file_6dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dc32 module procedure to_file_7dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dc128 module procedure to_file_7dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dc64 module procedure to_file_7dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dc32 module procedure to_file_8dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dc128 module procedure to_file_8dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dc64 module procedure to_file_8dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dc32 module procedure to_file_9dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dc128 module procedure to_file_9dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dc64 module procedure to_file_9dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dc32 module procedure to_file_10dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dc128 module procedure to_file_10dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dc64 module procedure to_file_10dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dc32 module procedure to_file_11dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dc128 module procedure to_file_11dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dc64 module procedure to_file_11dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dc32 module procedure to_file_12dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dc128 module procedure to_file_12dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dc64 module procedure to_file_12dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dc32 module procedure to_file_13dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dc128 module procedure to_file_13dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dc64 module procedure to_file_13dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dc32 module procedure to_file_14dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dc128 module procedure to_file_14dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dc64 module procedure to_file_14dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dc32 module procedure to_file_15dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dc128 module procedure to_file_15dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dc64 module procedure to_file_15dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dc32 module procedure to_file_1dr128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dr128 module procedure to_file_1dr64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dr64 module procedure to_file_1dr32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dr32 module procedure to_file_2dr128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dr128 module procedure to_file_2dr64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dr64 module procedure to_file_2dr32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dr32 module procedure to_file_3dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dr128 module procedure to_file_3dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dr64 module procedure to_file_3dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dr32 module procedure to_file_4dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dr128 module procedure to_file_4dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dr64 module procedure to_file_4dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dr32 module procedure to_file_5dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dr128 module procedure to_file_5dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dr64 module procedure to_file_5dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dr32 module procedure to_file_6dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dr128 module procedure to_file_6dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dr64 module procedure to_file_6dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dr32 module procedure to_file_7dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dr128 module procedure to_file_7dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dr64 module procedure to_file_7dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dr32 module procedure to_file_8dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dr128 module procedure to_file_8dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dr64 module procedure to_file_8dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dr32 module procedure to_file_9dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dr128 module procedure to_file_9dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dr64 module procedure to_file_9dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dr32 module procedure to_file_10dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dr128 module procedure to_file_10dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dr64 module procedure to_file_10dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dr32 module procedure to_file_11dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dr128 module procedure to_file_11dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dr64 module procedure to_file_11dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dr32 module procedure to_file_12dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dr128 module procedure to_file_12dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dr64 module procedure to_file_12dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dr32 module procedure to_file_13dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dr128 module procedure to_file_13dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dr64 module procedure to_file_13dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dr32 module procedure to_file_14dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dr128 module procedure to_file_14dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dr64 module procedure to_file_14dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dr32 module procedure to_file_15dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dr128 module procedure to_file_15dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dr64 module procedure to_file_15dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dr32 module procedure to_file_1di64 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di64 module procedure to_file_1di32 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di32 module procedure to_file_1di16 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di16 module procedure to_file_1di8 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di8 module procedure to_file_2di64 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di64 module procedure to_file_2di32 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di32 module procedure to_file_2di16 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di16 module procedure to_file_2di8 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di8 module procedure to_file_3di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di64 module procedure to_file_3di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di32 module procedure to_file_3di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di16 module procedure to_file_3di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di8 module procedure to_file_4di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di64 module procedure to_file_4di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di32 module procedure to_file_4di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di16 module procedure to_file_4di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di8 module procedure to_file_5di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di64 module procedure to_file_5di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di32 module procedure to_file_5di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di16 module procedure to_file_5di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di8 module procedure to_file_6di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di64 module procedure to_file_6di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di32 module procedure to_file_6di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di16 module procedure to_file_6di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di8 module procedure to_file_7di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di64 module procedure to_file_7di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di32 module procedure to_file_7di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di16 module procedure to_file_7di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di8 module procedure to_file_8di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di64 module procedure to_file_8di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di32 module procedure to_file_8di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di16 module procedure to_file_8di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di8 module procedure to_file_9di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di64 module procedure to_file_9di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di32 module procedure to_file_9di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di16 module procedure to_file_9di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di8 module procedure to_file_10di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di64 module procedure to_file_10di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di32 module procedure to_file_10di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di16 module procedure to_file_10di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di8 module procedure to_file_11di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di64 module procedure to_file_11di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di32 module procedure to_file_11di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di16 module procedure to_file_11di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di8 module procedure to_file_12di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di64 module procedure to_file_12di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di32 module procedure to_file_12di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di16 module procedure to_file_12di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di8 module procedure to_file_13di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di64 module procedure to_file_13di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di32 module procedure to_file_13di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di16 module procedure to_file_13di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di8 module procedure to_file_14di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di64 module procedure to_file_14di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di32 module procedure to_file_14di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di16 module procedure to_file_14di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di8 module procedure to_file_15di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di64 module procedure to_file_15di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di32 module procedure to_file_15di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di16 module procedure to_file_15di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di8 ! Reading Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure from_textfile_1dc128 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dc128 module procedure from_binaryfile_1dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dc128 module procedure from_textfile_1dc64 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dc64 module procedure from_binaryfile_1dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dc64 module procedure from_textfile_1dc32 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dc32 module procedure from_binaryfile_1dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dc32 module procedure from_textfile_2dc128 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dc128 module procedure from_binaryfile_2dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dc128 module procedure from_textfile_2dc64 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dc64 module procedure from_binaryfile_2dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dc64 module procedure from_textfile_2dc32 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dc32 module procedure from_binaryfile_2dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dc32 module procedure from_file_3dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dc128 module procedure from_file_3dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dc64 module procedure from_file_3dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dc32 module procedure from_file_4dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dc128 module procedure from_file_4dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dc64 module procedure from_file_4dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dc32 module procedure from_file_5dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dc128 module procedure from_file_5dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dc64 module procedure from_file_5dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dc32 module procedure from_file_6dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dc128 module procedure from_file_6dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dc64 module procedure from_file_6dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dc32 module procedure from_file_7dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dc128 module procedure from_file_7dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dc64 module procedure from_file_7dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dc32 module procedure from_file_8dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dc128 module procedure from_file_8dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dc64 module procedure from_file_8dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dc32 module procedure from_file_9dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dc128 module procedure from_file_9dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dc64 module procedure from_file_9dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dc32 module procedure from_file_10dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dc128 module procedure from_file_10dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dc64 module procedure from_file_10dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dc32 module procedure from_file_11dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dc128 module procedure from_file_11dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dc64 module procedure from_file_11dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dc32 module procedure from_file_12dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dc128 module procedure from_file_12dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dc64 module procedure from_file_12dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dc32 module procedure from_file_13dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dc128 module procedure from_file_13dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dc64 module procedure from_file_13dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dc32 module procedure from_file_14dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dc128 module procedure from_file_14dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dc64 module procedure from_file_14dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dc32 module procedure from_file_15dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dc128 module procedure from_file_15dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dc64 module procedure from_file_15dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dc32 module procedure from_textfile_1dr128 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dr128 module procedure from_binaryfile_1dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dr128 module procedure from_textfile_1dr64 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dr64 module procedure from_binaryfile_1dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dr64 module procedure from_textfile_1dr32 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dr32 module procedure from_binaryfile_1dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dr32 module procedure from_textfile_2dr128 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dr128 module procedure from_binaryfile_2dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dr128 module procedure from_textfile_2dr64 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dr64 module procedure from_binaryfile_2dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dr64 module procedure from_textfile_2dr32 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dr32 module procedure from_binaryfile_2dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dr32 module procedure from_file_3dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dr128 module procedure from_file_3dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dr64 module procedure from_file_3dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dr32 module procedure from_file_4dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dr128 module procedure from_file_4dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dr64 module procedure from_file_4dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dr32 module procedure from_file_5dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dr128 module procedure from_file_5dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dr64 module procedure from_file_5dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dr32 module procedure from_file_6dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dr128 module procedure from_file_6dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dr64 module procedure from_file_6dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dr32 module procedure from_file_7dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dr128 module procedure from_file_7dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dr64 module procedure from_file_7dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dr32 module procedure from_file_8dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dr128 module procedure from_file_8dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dr64 module procedure from_file_8dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dr32 module procedure from_file_9dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dr128 module procedure from_file_9dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dr64 module procedure from_file_9dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dr32 module procedure from_file_10dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dr128 module procedure from_file_10dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dr64 module procedure from_file_10dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dr32 module procedure from_file_11dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dr128 module procedure from_file_11dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dr64 module procedure from_file_11dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dr32 module procedure from_file_12dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dr128 module procedure from_file_12dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dr64 module procedure from_file_12dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dr32 module procedure from_file_13dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dr128 module procedure from_file_13dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dr64 module procedure from_file_13dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dr32 module procedure from_file_14dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dr128 module procedure from_file_14dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dr64 module procedure from_file_14dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dr32 module procedure from_file_15dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dr128 module procedure from_file_15dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dr64 module procedure from_file_15dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dr32 module procedure from_textfile_1di64 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di64 module procedure from_binaryfile_1di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di64 module procedure from_textfile_1di32 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di32 module procedure from_binaryfile_1di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di32 module procedure from_textfile_1di16 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di16 module procedure from_binaryfile_1di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di16 module procedure from_textfile_1di8 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di8 module procedure from_binaryfile_1di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di8 module procedure from_textfile_2di64 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di64 module procedure from_binaryfile_2di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di64 module procedure from_textfile_2di32 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di32 module procedure from_binaryfile_2di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di32 module procedure from_textfile_2di16 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di16 module procedure from_binaryfile_2di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di16 module procedure from_textfile_2di8 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di8 module procedure from_binaryfile_2di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di8 module procedure from_file_3di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di64 module procedure from_file_3di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di32 module procedure from_file_3di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di16 module procedure from_file_3di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di8 module procedure from_file_4di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di64 module procedure from_file_4di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di32 module procedure from_file_4di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di16 module procedure from_file_4di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di8 module procedure from_file_5di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di64 module procedure from_file_5di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di32 module procedure from_file_5di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di16 module procedure from_file_5di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di8 module procedure from_file_6di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di64 module procedure from_file_6di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di32 module procedure from_file_6di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di16 module procedure from_file_6di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di8 module procedure from_file_7di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di64 module procedure from_file_7di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di32 module procedure from_file_7di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di16 module procedure from_file_7di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di8 module procedure from_file_8di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di64 module procedure from_file_8di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di32 module procedure from_file_8di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di16 module procedure from_file_8di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di8 module procedure from_file_9di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di64 module procedure from_file_9di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di32 module procedure from_file_9di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di16 module procedure from_file_9di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di8 module procedure from_file_10di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di64 module procedure from_file_10di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di32 module procedure from_file_10di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di16 module procedure from_file_10di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di8 module procedure from_file_11di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di64 module procedure from_file_11di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di32 module procedure from_file_11di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di16 module procedure from_file_11di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di8 module procedure from_file_12di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di64 module procedure from_file_12di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di32 module procedure from_file_12di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di16 module procedure from_file_12di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di8 module procedure from_file_13di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di64 module procedure from_file_13di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di32 module procedure from_file_13di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di16 module procedure from_file_13di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di8 module procedure from_file_14di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di64 module procedure from_file_14di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di32 module procedure from_file_14di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di16 module procedure from_file_14di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di8 module procedure from_file_15di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di64 module procedure from_file_15di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di32 module procedure from_file_15di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di16 module procedure from_file_15di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di8 end submodule file_io submodule (io_fortran_lib) text_io !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **public interface** `echo` and the **private !! interfaces** `to_text` and `from_text`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains ! Writing Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure echo_chars character(len=:), allocatable :: ext, terminator_ logical :: exists, append_ integer :: file_unit ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT) return end if if ( len(substring, kind=int64) == 0_int64 ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". '// & 'String to write is empty.' return end if if ( .not. present(append) ) then append_ = .true. else append_ = append end if if ( .not. present(terminator) ) then terminator_ = LF else terminator_ = terminator end if inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else if ( .not. append_ ) then open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='write', access='stream', position='append' ) end if end if write( unit=file_unit ) substring//terminator_ close(file_unit) end procedure echo_chars module procedure echo_string character(len=:), allocatable :: ext, terminator_ logical :: exists, append_ integer :: file_unit ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT) return end if if ( substring%len64() < 1_int64 ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". '// & 'String to write is empty.' return end if if ( .not. present(append) ) then append_ = .true. else append_ = append end if if ( .not. present(terminator) ) then terminator_ = LF else terminator_ = terminator end if inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else if ( .not. append_ ) then open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='write', access='stream', position='append' ) end if end if write( unit=file_unit ) substring%s//terminator_ close(file_unit) end procedure echo_string module procedure to_text_1dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells(2_int64,:), locale=locale, fmt=fmt, decimals=decimals, im=im) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells(1_int64,:), locale=locale, fmt=fmt, decimals=decimals, im=im) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dc128 module procedure to_text_1dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells(2_int64,:), locale=locale, fmt=fmt, decimals=decimals, im=im) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells(1_int64,:), locale=locale, fmt=fmt, decimals=decimals, im=im) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dc64 module procedure to_text_1dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells(2_int64,:), locale=locale, fmt=fmt, decimals=decimals, im=im) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells(1_int64,:), locale=locale, fmt=fmt, decimals=decimals, im=im) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dc32 module procedure to_text_2dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells, locale=locale, fmt=fmt, decimals=decimals, im=im) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dc128 module procedure to_text_2dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells, locale=locale, fmt=fmt, decimals=decimals, im=im) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dc64 module procedure to_text_2dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), locale=locale, fmt=fmt, decimals=decimals, im=im) else call cast(x, into=cells, locale=locale, fmt=fmt, decimals=decimals, im=im) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dc32 module procedure to_text_1dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells(2_int64,:), locale=locale, fmt=fmt, decimals=decimals) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells(1_int64,:), locale=locale, fmt=fmt, decimals=decimals) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dr128 module procedure to_text_1dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells(2_int64,:), locale=locale, fmt=fmt, decimals=decimals) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells(1_int64,:), locale=locale, fmt=fmt, decimals=decimals) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dr64 module procedure to_text_1dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells(2_int64,:), locale=locale, fmt=fmt, decimals=decimals) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells(1_int64,:), locale=locale, fmt=fmt, decimals=decimals) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dr32 module procedure to_text_2dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells, locale=locale, fmt=fmt, decimals=decimals) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dr128 module procedure to_text_2dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells, locale=locale, fmt=fmt, decimals=decimals) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dr64 module procedure to_text_2dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), locale=locale, fmt=fmt, decimals=decimals) else call cast(x, into=cells, locale=locale, fmt=fmt, decimals=decimals) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dr32 module procedure to_text_1di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), fmt=fmt) else call cast(x, into=cells(2_int64,:), fmt=fmt) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), fmt=fmt) else call cast(x, into=cells(1_int64,:), fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di64 module procedure to_text_1di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), fmt=fmt) else call cast(x, into=cells(2_int64,:), fmt=fmt) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), fmt=fmt) else call cast(x, into=cells(1_int64,:), fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di32 module procedure to_text_1di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), fmt=fmt) else call cast(x, into=cells(2_int64,:), fmt=fmt) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), fmt=fmt) else call cast(x, into=cells(1_int64,:), fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di16 module procedure to_text_1di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then call cast(x, into=cells(2_int64:,1_int64), fmt=fmt) else call cast(x, into=cells(2_int64,:), fmt=fmt) end if else if ( dim == 1 ) then call cast(x, into=cells(:,1_int64), fmt=fmt) else call cast(x, into=cells(1_int64,:), fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di8 module procedure to_text_2di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), fmt=fmt) else call cast(x, into=cells, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di64 module procedure to_text_2di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), fmt=fmt) else call cast(x, into=cells, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di32 module procedure to_text_2di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), fmt=fmt) else call cast(x, into=cells, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di16 module procedure to_text_2di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then call cast(x, into=cells(2_int64:,:), fmt=fmt) else call cast(x, into=cells, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di8 ! Reading Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure from_text_1dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block integer(int64) :: file_length, row, col, l, i integer :: row_sep, col_sep, col_sep_len, open_paren, close_paren, current integer :: file_unit, iostat logical :: exists, in_paren inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if col_sep_len = len(delim) row_sep = iachar(NL); col_sep = iachar(delim(1:1)) open_paren = iachar('('); close_paren = iachar(')'); in_paren = .false. n_rows = text_file%count(match=NL) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) exit get_n_cols end do get_n_cols allocate( cells(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cells(row,col)%s = text_file%s(l:i-1); i = i + 1_int64; l = i col = col + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then cells(row,col)%s = text_file%s(l:i-1); i = i + col_sep_len; l = i col = col + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then cells(row,col)%s = text_file%s(l:i-1) if ( row == n_rows ) exit custom_processing i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle end if end do positional_transfers end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_1dc128 module procedure from_text_1dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block integer(int64) :: file_length, row, col, l, i integer :: row_sep, col_sep, col_sep_len, open_paren, close_paren, current integer :: file_unit, iostat logical :: exists, in_paren inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if col_sep_len = len(delim) row_sep = iachar(NL); col_sep = iachar(delim(1:1)) open_paren = iachar('('); close_paren = iachar(')'); in_paren = .false. n_rows = text_file%count(match=NL) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) exit get_n_cols end do get_n_cols allocate( cells(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cells(row,col)%s = text_file%s(l:i-1); i = i + 1_int64; l = i col = col + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then cells(row,col)%s = text_file%s(l:i-1); i = i + col_sep_len; l = i col = col + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then cells(row,col)%s = text_file%s(l:i-1) if ( row == n_rows ) exit custom_processing i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle end if end do positional_transfers end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_1dc64 module procedure from_text_1dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block integer(int64) :: file_length, row, col, l, i integer :: row_sep, col_sep, col_sep_len, open_paren, close_paren, current integer :: file_unit, iostat logical :: exists, in_paren inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if col_sep_len = len(delim) row_sep = iachar(NL); col_sep = iachar(delim(1:1)) open_paren = iachar('('); close_paren = iachar(')'); in_paren = .false. n_rows = text_file%count(match=NL) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) exit get_n_cols end do get_n_cols allocate( cells(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cells(row,col)%s = text_file%s(l:i-1); i = i + 1_int64; l = i col = col + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then cells(row,col)%s = text_file%s(l:i-1); i = i + col_sep_len; l = i col = col + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then cells(row,col)%s = text_file%s(l:i-1) if ( row == n_rows ) exit custom_processing i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle end if end do positional_transfers end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_1dc32 module procedure from_text_2dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block integer(int64) :: file_length, row, col, l, i integer :: row_sep, col_sep, col_sep_len, open_paren, close_paren, current integer :: file_unit, iostat logical :: exists, in_paren inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if col_sep_len = len(delim) row_sep = iachar(NL); col_sep = iachar(delim(1:1)) open_paren = iachar('('); close_paren = iachar(')'); in_paren = .false. n_rows = text_file%count(match=NL) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) exit get_n_cols end do get_n_cols allocate( cells(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cells(row,col)%s = text_file%s(l:i-1); i = i + 1_int64; l = i col = col + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then cells(row,col)%s = text_file%s(l:i-1); i = i + col_sep_len; l = i col = col + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then cells(row,col)%s = text_file%s(l:i-1) if ( row == n_rows ) exit custom_processing i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle end if end do positional_transfers end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_2dc128 module procedure from_text_2dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block integer(int64) :: file_length, row, col, l, i integer :: row_sep, col_sep, col_sep_len, open_paren, close_paren, current integer :: file_unit, iostat logical :: exists, in_paren inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if col_sep_len = len(delim) row_sep = iachar(NL); col_sep = iachar(delim(1:1)) open_paren = iachar('('); close_paren = iachar(')'); in_paren = .false. n_rows = text_file%count(match=NL) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) exit get_n_cols end do get_n_cols allocate( cells(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cells(row,col)%s = text_file%s(l:i-1); i = i + 1_int64; l = i col = col + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then cells(row,col)%s = text_file%s(l:i-1); i = i + col_sep_len; l = i col = col + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then cells(row,col)%s = text_file%s(l:i-1) if ( row == n_rows ) exit custom_processing i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle end if end do positional_transfers end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_2dc64 module procedure from_text_2dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block integer(int64) :: file_length, row, col, l, i integer :: row_sep, col_sep, col_sep_len, open_paren, close_paren, current integer :: file_unit, iostat logical :: exists, in_paren inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if col_sep_len = len(delim) row_sep = iachar(NL); col_sep = iachar(delim(1:1)) open_paren = iachar('('); close_paren = iachar(')'); in_paren = .false. n_rows = text_file%count(match=NL) n_cols = 1_int64; i = 1_int64; get_n_cols: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then n_cols = n_cols + 1_int64; i = i + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then n_cols = n_cols + 1_int64; i = i + col_sep_len; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) exit get_n_cols end do get_n_cols allocate( cells(n_rows,n_cols) ) row = 1_int64; col = 1_int64; l = 1_int64; i = 1_int64; positional_transfers: do current = iachar(text_file%s(i:i)) if ( (current/=open_paren) .and. (current/=close_paren) .and. (current/=col_sep) .and. & (current/=row_sep) ) then i = i + 1_int64; cycle end if if ( current == open_paren ) then in_paren = .true.; i = i + 1_int64; cycle end if if ( current == close_paren ) then in_paren = .false.; i = i + 1_int64; cycle end if if ( current == col_sep ) then if ( in_paren ) then i = i + 1_int64; cycle end if if ( col_sep_len == 1 ) then cells(row,col)%s = text_file%s(l:i-1); i = i + 1_int64; l = i col = col + 1_int64; cycle else if ( text_file%s(i:i+col_sep_len-1_int64) == delim ) then cells(row,col)%s = text_file%s(l:i-1); i = i + col_sep_len; l = i col = col + 1_int64; cycle else i = i + 1_int64; cycle end if end if end if if ( current == row_sep ) then cells(row,col)%s = text_file%s(l:i-1) if ( row == n_rows ) exit custom_processing i = i + 1_int64; l = i; col = 1_int64; row = row + 1_int64; cycle end if end do positional_transfers end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_2dc32 module procedure from_text_1dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_1dr128 module procedure from_text_1dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_1dr64 module procedure from_text_1dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_1dr32 module procedure from_text_2dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_2dr128 module procedure from_text_2dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_2dr64 module procedure from_text_2dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_2dr32 module procedure from_text_1di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di64 module procedure from_text_1di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di32 module procedure from_text_1di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di16 module procedure from_text_1di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di8 module procedure from_text_2di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di64 module procedure from_text_2di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di32 module procedure from_text_2di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di16 module procedure from_text_2di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di8 end submodule text_io submodule (io_fortran_lib) binary_io !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **private interfaces** `to_binary` and !! `from_binary`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains ! Writing Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure to_binary_1dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dc128 module procedure to_binary_1dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dc64 module procedure to_binary_1dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dc32 module procedure to_binary_2dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dc128 module procedure to_binary_2dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dc64 module procedure to_binary_2dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dc32 module procedure to_binary_3dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dc128 module procedure to_binary_3dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dc64 module procedure to_binary_3dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dc32 module procedure to_binary_4dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dc128 module procedure to_binary_4dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dc64 module procedure to_binary_4dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dc32 module procedure to_binary_5dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dc128 module procedure to_binary_5dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dc64 module procedure to_binary_5dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dc32 module procedure to_binary_6dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dc128 module procedure to_binary_6dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dc64 module procedure to_binary_6dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dc32 module procedure to_binary_7dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dc128 module procedure to_binary_7dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dc64 module procedure to_binary_7dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dc32 module procedure to_binary_8dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dc128 module procedure to_binary_8dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dc64 module procedure to_binary_8dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dc32 module procedure to_binary_9dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dc128 module procedure to_binary_9dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dc64 module procedure to_binary_9dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dc32 module procedure to_binary_10dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dc128 module procedure to_binary_10dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dc64 module procedure to_binary_10dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dc32 module procedure to_binary_11dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dc128 module procedure to_binary_11dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dc64 module procedure to_binary_11dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dc32 module procedure to_binary_12dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dc128 module procedure to_binary_12dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dc64 module procedure to_binary_12dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dc32 module procedure to_binary_13dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dc128 module procedure to_binary_13dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dc64 module procedure to_binary_13dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dc32 module procedure to_binary_14dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dc128 module procedure to_binary_14dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dc64 module procedure to_binary_14dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dc32 module procedure to_binary_15dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dc128 module procedure to_binary_15dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dc64 module procedure to_binary_15dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dc32 module procedure to_binary_1dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dr128 module procedure to_binary_1dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dr64 module procedure to_binary_1dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dr32 module procedure to_binary_2dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dr128 module procedure to_binary_2dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dr64 module procedure to_binary_2dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dr32 module procedure to_binary_3dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dr128 module procedure to_binary_3dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dr64 module procedure to_binary_3dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dr32 module procedure to_binary_4dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dr128 module procedure to_binary_4dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dr64 module procedure to_binary_4dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dr32 module procedure to_binary_5dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dr128 module procedure to_binary_5dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dr64 module procedure to_binary_5dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dr32 module procedure to_binary_6dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dr128 module procedure to_binary_6dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dr64 module procedure to_binary_6dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dr32 module procedure to_binary_7dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dr128 module procedure to_binary_7dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dr64 module procedure to_binary_7dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dr32 module procedure to_binary_8dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dr128 module procedure to_binary_8dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dr64 module procedure to_binary_8dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dr32 module procedure to_binary_9dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dr128 module procedure to_binary_9dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dr64 module procedure to_binary_9dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dr32 module procedure to_binary_10dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dr128 module procedure to_binary_10dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dr64 module procedure to_binary_10dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dr32 module procedure to_binary_11dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dr128 module procedure to_binary_11dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dr64 module procedure to_binary_11dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dr32 module procedure to_binary_12dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dr128 module procedure to_binary_12dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dr64 module procedure to_binary_12dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dr32 module procedure to_binary_13dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dr128 module procedure to_binary_13dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dr64 module procedure to_binary_13dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dr32 module procedure to_binary_14dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dr128 module procedure to_binary_14dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dr64 module procedure to_binary_14dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dr32 module procedure to_binary_15dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dr128 module procedure to_binary_15dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dr64 module procedure to_binary_15dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dr32 module procedure to_binary_1di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di64 module procedure to_binary_1di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di32 module procedure to_binary_1di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di16 module procedure to_binary_1di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di8 module procedure to_binary_2di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di64 module procedure to_binary_2di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di32 module procedure to_binary_2di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di16 module procedure to_binary_2di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di8 module procedure to_binary_3di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di64 module procedure to_binary_3di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di32 module procedure to_binary_3di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di16 module procedure to_binary_3di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di8 module procedure to_binary_4di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di64 module procedure to_binary_4di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di32 module procedure to_binary_4di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di16 module procedure to_binary_4di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di8 module procedure to_binary_5di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di64 module procedure to_binary_5di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di32 module procedure to_binary_5di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di16 module procedure to_binary_5di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di8 module procedure to_binary_6di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di64 module procedure to_binary_6di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di32 module procedure to_binary_6di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di16 module procedure to_binary_6di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di8 module procedure to_binary_7di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di64 module procedure to_binary_7di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di32 module procedure to_binary_7di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di16 module procedure to_binary_7di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di8 module procedure to_binary_8di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di64 module procedure to_binary_8di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di32 module procedure to_binary_8di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di16 module procedure to_binary_8di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di8 module procedure to_binary_9di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di64 module procedure to_binary_9di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di32 module procedure to_binary_9di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di16 module procedure to_binary_9di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di8 module procedure to_binary_10di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di64 module procedure to_binary_10di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di32 module procedure to_binary_10di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di16 module procedure to_binary_10di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di8 module procedure to_binary_11di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di64 module procedure to_binary_11di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di32 module procedure to_binary_11di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di16 module procedure to_binary_11di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di8 module procedure to_binary_12di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di64 module procedure to_binary_12di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di32 module procedure to_binary_12di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di16 module procedure to_binary_12di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di8 module procedure to_binary_13di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di64 module procedure to_binary_13di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di32 module procedure to_binary_13di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di16 module procedure to_binary_13di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di8 module procedure to_binary_14di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di64 module procedure to_binary_14di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di32 module procedure to_binary_14di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di16 module procedure to_binary_14di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di8 module procedure to_binary_15di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di64 module procedure to_binary_15di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di32 module procedure to_binary_15di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di16 module procedure to_binary_15di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di8 ! Reading Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure from_binary_1dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dc128 module procedure from_binary_1dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dc64 module procedure from_binary_1dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dc32 module procedure from_binary_2dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dc128 module procedure from_binary_2dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dc64 module procedure from_binary_2dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dc32 module procedure from_binary_3dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dc128 module procedure from_binary_3dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dc64 module procedure from_binary_3dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dc32 module procedure from_binary_4dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dc128 module procedure from_binary_4dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dc64 module procedure from_binary_4dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dc32 module procedure from_binary_5dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dc128 module procedure from_binary_5dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dc64 module procedure from_binary_5dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dc32 module procedure from_binary_6dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dc128 module procedure from_binary_6dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dc64 module procedure from_binary_6dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dc32 module procedure from_binary_7dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dc128 module procedure from_binary_7dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dc64 module procedure from_binary_7dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dc32 module procedure from_binary_8dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dc128 module procedure from_binary_8dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dc64 module procedure from_binary_8dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dc32 module procedure from_binary_9dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dc128 module procedure from_binary_9dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dc64 module procedure from_binary_9dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dc32 module procedure from_binary_10dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dc128 module procedure from_binary_10dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dc64 module procedure from_binary_10dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dc32 module procedure from_binary_11dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dc128 module procedure from_binary_11dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dc64 module procedure from_binary_11dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dc32 module procedure from_binary_12dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dc128 module procedure from_binary_12dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dc64 module procedure from_binary_12dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dc32 module procedure from_binary_13dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dc128 module procedure from_binary_13dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dc64 module procedure from_binary_13dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dc32 module procedure from_binary_14dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dc128 module procedure from_binary_14dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dc64 module procedure from_binary_14dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dc32 module procedure from_binary_15dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dc128 module procedure from_binary_15dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dc64 module procedure from_binary_15dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dc32 module procedure from_binary_1dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dr128 module procedure from_binary_1dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dr64 module procedure from_binary_1dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dr32 module procedure from_binary_2dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dr128 module procedure from_binary_2dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dr64 module procedure from_binary_2dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dr32 module procedure from_binary_3dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dr128 module procedure from_binary_3dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dr64 module procedure from_binary_3dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dr32 module procedure from_binary_4dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dr128 module procedure from_binary_4dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dr64 module procedure from_binary_4dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dr32 module procedure from_binary_5dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dr128 module procedure from_binary_5dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dr64 module procedure from_binary_5dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dr32 module procedure from_binary_6dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dr128 module procedure from_binary_6dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dr64 module procedure from_binary_6dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dr32 module procedure from_binary_7dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dr128 module procedure from_binary_7dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dr64 module procedure from_binary_7dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dr32 module procedure from_binary_8dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dr128 module procedure from_binary_8dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dr64 module procedure from_binary_8dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dr32 module procedure from_binary_9dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dr128 module procedure from_binary_9dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dr64 module procedure from_binary_9dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dr32 module procedure from_binary_10dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dr128 module procedure from_binary_10dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dr64 module procedure from_binary_10dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dr32 module procedure from_binary_11dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dr128 module procedure from_binary_11dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dr64 module procedure from_binary_11dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dr32 module procedure from_binary_12dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dr128 module procedure from_binary_12dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dr64 module procedure from_binary_12dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dr32 module procedure from_binary_13dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dr128 module procedure from_binary_13dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dr64 module procedure from_binary_13dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dr32 module procedure from_binary_14dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dr128 module procedure from_binary_14dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dr64 module procedure from_binary_14dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dr32 module procedure from_binary_15dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dr128 module procedure from_binary_15dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dr64 module procedure from_binary_15dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dr32 module procedure from_binary_1di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di64 module procedure from_binary_1di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di32 module procedure from_binary_1di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di16 module procedure from_binary_1di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di8 module procedure from_binary_2di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di64 module procedure from_binary_2di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di32 module procedure from_binary_2di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di16 module procedure from_binary_2di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di8 module procedure from_binary_3di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di64 module procedure from_binary_3di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di32 module procedure from_binary_3di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di16 module procedure from_binary_3di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di8 module procedure from_binary_4di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di64 module procedure from_binary_4di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di32 module procedure from_binary_4di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di16 module procedure from_binary_4di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di8 module procedure from_binary_5di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di64 module procedure from_binary_5di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di32 module procedure from_binary_5di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di16 module procedure from_binary_5di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di8 module procedure from_binary_6di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di64 module procedure from_binary_6di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di32 module procedure from_binary_6di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di16 module procedure from_binary_6di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di8 module procedure from_binary_7di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di64 module procedure from_binary_7di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di32 module procedure from_binary_7di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di16 module procedure from_binary_7di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di8 module procedure from_binary_8di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di64 module procedure from_binary_8di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di32 module procedure from_binary_8di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di16 module procedure from_binary_8di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di8 module procedure from_binary_9di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di64 module procedure from_binary_9di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di32 module procedure from_binary_9di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di16 module procedure from_binary_9di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di8 module procedure from_binary_10di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di64 module procedure from_binary_10di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di32 module procedure from_binary_10di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di16 module procedure from_binary_10di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di8 module procedure from_binary_11di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di64 module procedure from_binary_11di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di32 module procedure from_binary_11di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di16 module procedure from_binary_11di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di8 module procedure from_binary_12di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di64 module procedure from_binary_12di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di32 module procedure from_binary_12di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di16 module procedure from_binary_12di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di8 module procedure from_binary_13di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di64 module procedure from_binary_13di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di32 module procedure from_binary_13di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di16 module procedure from_binary_13di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di8 module procedure from_binary_14di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di64 module procedure from_binary_14di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di32 module procedure from_binary_14di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di16 module procedure from_binary_14di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di8 module procedure from_binary_15di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di64 module procedure from_binary_15di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di32 module procedure from_binary_15di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di16 module procedure from_binary_15di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di8 end submodule binary_io submodule (io_fortran_lib) array_printing !------------------------------------------------------------------------------------------------------------------ !! This submodule provides module procedure implementations for the **public interface** `aprint`. !------------------------------------------------------------------------------------------------------------------ implicit none (type,external) contains module procedure aprint_1dc128 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_1dc128 module procedure aprint_1dc64 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_1dc64 module procedure aprint_1dc32 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_1dc32 module procedure aprint_2dc128 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, j, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_2dc128 module procedure aprint_2dc64 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, j, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_2dc64 module procedure aprint_2dc32 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, j, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_2dc32 module procedure aprint_1dr128 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_1dr128 module procedure aprint_1dr64 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_1dr64 module procedure aprint_1dr32 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_1dr32 module procedure aprint_2dr128 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, j, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_2dr128 module procedure aprint_2dr64 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, j, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_2dr64 module procedure aprint_2dr32 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, j, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_2dr32 module procedure aprint_1di64 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di64 module procedure aprint_1di32 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di32 module procedure aprint_1di16 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di16 module procedure aprint_1di8 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di8 module procedure aprint_2di64 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di64 module procedure aprint_2di32 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di32 module procedure aprint_2di16 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di16 module procedure aprint_2di8 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di8 module procedure aprint_1dchar type(String), allocatable, dimension(:) :: rows integer :: i allocate( rows(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent(i = lbound(x, dim=1):ubound(x, dim=1)) if ( i == lbound(x, dim=1) ) then if ( i == ubound(x, dim=1) ) then rows(i)%s = LF//' '//adjustl( x(i) )//LF else rows(i)%s = LF//' '//adjustl( x(i) ) end if else if ( i == ubound(x, dim=1) ) then rows(i)%s = ' '//adjustl( x(i) )//LF else rows(i)%s = ' '//adjustl( x(i) ) end if end do do i = lbound(x, dim=1), ubound(x, dim=1) write(*,'(a)') rows(i)%s end do end procedure aprint_1dchar module procedure aprint_2dchar type(String), allocatable, dimension(:) :: rows integer :: i allocate( rows(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent(i = lbound(x, dim=1):ubound(x, dim=1)) if ( i == lbound(x, dim=1) ) then if ( i == ubound(x, dim=1) ) then rows(i)%s = LF//' '//accum( x(i,:) )//LF else rows(i)%s = LF//' '//accum( x(i,:) ) end if else if ( i == ubound(x, dim=1) ) then rows(i)%s = ' '//accum( x(i,:) )//LF else rows(i)%s = ' '//accum( x(i,:) ) end if end do do i = lbound(x, dim=1), ubound(x, dim=1) write(*,'(a)') rows(i)%s end do contains pure recursive function accum(x) result(x_str) character(len=*), dimension(:), intent(in) :: x character(len=:), allocatable :: x_str integer :: x_len, x_size, i, pos x_len = len(x) x_size = size(x) if ( x_size == 1 ) then x_str = x(1); return end if if ( x_len == 0 ) then x_str = EMPTY_STR; return end if allocate( character(len=x_len*x_size + x_size - 1) :: x_str ) positional_transfer: do concurrent (i = 1:x_size) pos = (i-1)*(x_len + 1) + 1 x_str(pos:pos+x_len-1) = adjustl(x(i)) if ( i < x_size ) x_str(pos+x_len:pos+x_len) = SPACE end do positional_transfer end function accum end procedure aprint_2dchar module procedure aprint_1dString character(len=:), allocatable, dimension(:) :: char_arr integer, allocatable, dimension(:) :: lengths integer :: i, max_length lengths = x%len() max_length = maxval(lengths) allocate( character(len=max_length) :: char_arr(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) if ( lengths(i) < 1 ) then char_arr(i) = EMPTY_STR else char_arr(i) = x(i)%s end if end do call aprint(char_arr) end procedure aprint_1dString module procedure aprint_2dString character(len=:), allocatable, dimension(:,:) :: char_arr integer, allocatable, dimension(:,:) :: lengths integer :: i, j, max_length lengths = x%len() max_length = maxval(lengths) allocate( character(len=max_length) :: & char_arr(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) if ( lengths(i,j) < 1 ) then char_arr(i,j) = EMPTY_STR else char_arr(i,j) = x(i,j)%s end if end do call aprint(char_arr) end procedure aprint_2dString end submodule array_printing !====================================================================================================================== ! List of workarounds for compiler bugs in ifx 2023.0.0 : ! ------------------------------------------------------- ! 1. In join_into_self (line 4808), the recursive call to join_into_self at line 4836 induces a run-time ! segmentation fault in the program contained in benchmark.f90 not seen with the following compilers: ifort ! 2021.8.0, gfortran 11.3.0, gfortran 11.2.0. From investigation, the segmentation fault seems due to the passing ! of the array of derived type. The fault occurs in a majority of runs, but not in every run. To avoid the fault, ! the array to be passed must be constructed element by element and passed as in the "else" section of the "if" ! block. The fault again seems to be induced only when "-heap-arrays 0" is specified and only with ifx 2023.0.0. !======================================================================================================================